(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "19-Oct-89 17:18:44" {ICE}<KOOMEN>LISPUSERS>MEDLEY>HOSTUP.;1
 9510   

      changes to%:  (VARS HOSTUPCOMS)

      previous date%: "19-Oct-89 16:52:50" {ICE}<KOOMEN>LISPUSERS>MEDLEY>HOSTUP.;1)


(* "
Copyright (c) 1988, 1989 by Johannes A. G. M. Koomen.  All rights reserved.
")

(PRETTYCOMPRINT HOSTUPCOMS)

(RPAQQ HOSTUPCOMS
 
       ((FNS HOSTUP?)
        (INITVARS (HOSTUP.TIMEOUT 15000)
               (HOSTUP.RETRYCNT 5))
        (GLOBALVARS HOSTUP.TIMEOUT HOSTUP.RETRYCNT)
        (DECLARE%: DONTEVAL@LOAD DONTCOPY EVAL@COMPILE
               (FILES SYSEDIT [FROM VALUEOF (for D in LISPUSERSDIRECTORIES until
                                                 (INFILEP (PACKFILENAME 'NAME 'LLNSDECLS 'BODY
                                                                 (SETQ $$VAL
                                                                       (PACKFILENAME
                                                                        'HOST
                                                                        (FILENAMEFIELD D 'HOST)
                                                                        'DIRECTORY
                                                                        (CONCAT "LISP>" MAKESYSNAME 
                                                                               ">SOURCES"]
                      LLNSDECLS
                      (LOADCOMP)
                      LLNS))))
(DEFINEQ

(HOSTUP?

  [LAMBDA (name)
                                        (* ; "Edited 19-Oct-89 16:51 by koomen")


    (* ;; "Adapted from FILECACHE function \FCACHE.HOSTUP?")


    (* ;; "Uses the globalvar HOSTUP.TIMEOUT (default: 15,000 msecs) to limit total wait time, and the globalvar HOSTUP.RETRYCNT (default: 5 times) to limit the number of retries")


                                                         (* smL " 3-Sep-86 16:04")


(* ;;; "Try to determine if the host if able to respond")


    (LET* [(DEV (\GETDEVICEFROMNAME name T NIL))
           (retryCount (MAX 1 (FIX HOSTUP.RETRYCNT)))
           (initialInterval (FIX (QUOTIENT (MAX 1000 HOSTUP.TIMEOUT)
                                        (SUB1 (LSH 1 retryCount]
          (SELECTQ (if
 DEV
                       then
 

                             (* ;; "use real DEV to determine the DEV type")


                             (SELECTQ (fetch
 OPENFILE of
 DEV)
                                 ((\LEAF.OPENFILE \FTP.OPENFILE) 
                                      'LEAF)
                                 (\NSFILING.OPENFILE 
                                      'NSFILING)
                                 (fetch
 DEVICENAME of
 DEV))
                     else
 

                           (* ;; 

                       "the FDEV doesn't exist, and we can't create one for it, so it must be down")


                           'NOFDEV)
              (LEAF 
                    (* ;; "We think its a LEAF server, so try PUP.ECHOUSER")


                    (RESETLST
                        (PROG ((i 1)
                               (interval initialInterval)
                               (PORT (BESTPUPADDRESS name PROMPTWINDOW))
                               (SOC (OPENPUPSOCKET))
                               echo OPUP IPUP ECHOPUPLENGTH)
                              (RESETSAVE NIL (LIST 'CLOSEPUPSOCKET SOC))
                              (OR PORT (RETURN NIL))
                          TryAgain
                              (if
 (IGREATERP i retryCount)
                                  then
 (RETURN NIL))
                              (SETQ OPUP (ALLOCATE.PUP))
                              (SETUPPUP OPUP PORT \PUPSOCKET.ECHO \PT.ECHOME NIL SOC T)
                              (PUTPUPWORD OPUP 0 1)
                              (add
 (fetch
 PUPLENGTH of
 OPUP)
                                     BYTESPERWORD)
                              (SETQ ECHOPUPLENGTH (fetch
 PUPLENGTH of
 OPUP))
                              (SENDPUP SOC OPUP)
                              [COND
                                 ((SETQ IPUP (GETPUP SOC interval))
                                  (COND
                                     ((PROG1 (AND (EQ (fetch
 PUPTYPE of
 IPUP)
                                                      \PT.IAMECHO)
                                                  (EQ (fetch
 PUPIDHI of
 IPUP)
                                                      (fetch
 PUPIDHI of
 OPUP))
                                                  (EQ (fetch
 PUPIDLO of
 IPUP)
                                                      (fetch
 PUPIDLO of
 OPUP))
                                                  (EQ (fetch
 PUPLENGTH of
 IPUP)
                                                      ECHOPUPLENGTH)
                                                  (IEQP (GETPUPWORD IPUP 0)
                                                        1))
                                             (RELEASE.PUP IPUP))
                                      (RETURN T]
                              (SETQ i (ADD1 i))
                              (SETQ interval (ITIMES interval 2))
                              (GO TryAgain))))
              (NSFILING                                      (* ; 

                                              "We think its an NSFILING server, so try NS.ECHOUSER")

                        (RESETLST
                            (PROG ((i 1)
                                   (interval initialInterval)
                                   (ECHOADDRESS (OR (COERCE-TO-NSADDRESS name \NS.WKS.Echo)
                                                    (\ILLEGAL.ARG name)))
                                   NSOC OXIP ECHOXIPLENGTH IXIP)
                                  (OR ECHOADDRESS (RETURN NIL))
                                  [RESETSAVE NIL (LIST 'CLOSENSOCKET (SETQ NSOC (OPENNSOCKET]
                                  (if
 (IGREATERP i retryCount)
                                      then
 (RETURN NIL))
                                  (SETQ OXIP (\FILLINXIP \XIPT.ECHO NSOC ECHOADDRESS))
                                  (XIPAPPEND.WORD OXIP \XECHO.OP.REQUEST)
                                  (XIPAPPEND.WORD OXIP 1)
                                  (SETQ ECHOXIPLENGTH (fetch
 XIPLENGTH of
 OXIP))
                              TryAgain
                                  (if
 (IGREATERP i retryCount)
                                      then
 (RETURN NIL))
                                  (SENDXIP NSOC OXIP)
                                  [COND
                                     ((SETQ IXIP (GETXIP NSOC interval))
                                      (COND
                                         ((PROG1 (AND (EQ (fetch
 XIPTYPE of
 IXIP)
                                                          \XIPT.ECHO)
                                                      (EQ (fetch
 XIPLENGTH of
 IXIP)
                                                          ECHOXIPLENGTH)
                                                      (EQ (\GETBASE (fetch
 XIPCONTENTS
                                                                       of
 IXIP)
                                                                 0)
                                                          \XECHO.OP.REPLY))
                                                 (RELEASE.XIP IXIP))
                                          (RETURN T]
                                  (SETQ i (ADD1 i))
                                  (SETQ interval (LLSH interval 1))
                                  (GO TryAgain))))
              (FLOPPY 
                      (* ;; "the FLOPPY disk")


                      (* ;; 

                    "Should be (FLOPPY.CAN.READP) but this triggers a bug in the Floppy handler")


                      T)
              (TCP 
                   (* ;; "A TCP device.  Punt on them")


                   T)
              (NOFDEV 
                      (* ;; "we can't create an FDEV for the device, so it can't be up")


                      NIL)
              T])
)

(RPAQ? HOSTUP.TIMEOUT
 15000)

(RPAQ? HOSTUP.RETRYCNT
 5)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS HOSTUP.TIMEOUT HOSTUP.RETRYCNT)
)
(DECLARE%: DONTEVAL@LOAD DONTCOPY EVAL@COMPILE 

(FILESLOAD SYSEDIT [FROM
 VALUEOF (for
 D in
 LISPUSERSDIRECTORIES
                                        until
 (INFILEP (PACKFILENAME 'NAME 'LLNSDECLS
                                                                  'BODY
                                                                  (SETQ $$VAL
                                                                   (PACKFILENAME 'HOST
                                                                          (FILENAMEFIELD D
                                                                                 'HOST)
                                                                          'DIRECTORY
                                                                          (CONCAT "LISP>" MAKESYSNAME
                                                                                 ">SOURCES"]
       LLNSDECLS
       (LOADCOMP)
       LLNS)
)
(PUTPROPS HOSTUP COPYRIGHT ("Johannes A. G. M. Koomen" 1988 1989))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1512 8312 (HOSTUP? 1522 . 8310)))))
STOP