LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032722. :SYSTEM-TYPE :LOGICAL :VERSION 1. :TYPE "LISP" :NAME "SCRIPT-HANDLER" :DIRECTORY ("REL3-PUBLIC" "PUBLIC" "KERMIT") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758121950. :AUTHOR "REL3" :LENGTH-IN-BYTES 7286. :LENGTH-IN-BLOCKS 8. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ;;; -*- Mode:Common-Lisp; Package:TELNET; Base:10 -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;;;;; Copyright (C) 1987, Texas Instruments Incorporated. All rights reserved.;;; Copyright (C) 1987 Unisys Corporation;;; All Rights Reserved(DEFVAR RESPONSE-POOL NIL  "Pool of strings for responses for PROCESS-CLAUSE.  List of entries.Car of entry is T if string is in use, else NIL.Cdr of entry is array.") (DEFUN GET-RESPONSE-STRING (&AUX temp)  "Gets an available string from pool."  (WITHOUT-INTERRUPTS    (IF (SETQ temp (ASSOC NIL RESPONSE-POOL))(PROGN  (RPLACA temp T)  (SETF (FILL-POINTER (CDR temp)) 0.)  (CDR temp));;force the area because this array is going to be kept around, so beware of temp AREAS.(LET ((DEFAULT-CONS-AREA SYSTEM:BACKGROUND-CONS-AREA))  (CDAR    (PUSH      `(T . ,(MAKE-ARRAY 10000. :TYPE 'ART-STRING :FILL-POINTER 0. :AREASYSTEM:BACKGROUND-CONS-AREA))      RESPONSE-POOL))))))(DEFUN RETURN-RESPONSE-STRING (array &AUX temp)  "Returns a string to pool."  (WITHOUT-INTERRUPTS    (WHEN (SETQ temp (RASSOC array RESPONSE-POOL))      (RPLACA temp NIL))))(DEFUN RUN-SCRIPT-FROM-FILE (filename &KEY (stream *TERMINAL-IO*) (debug-stream *DEBUG-IO*) (wait-time 300.)     ascii-translate)  (WITH-OPEN-FILE (file filename)    (RUN-SCRIPT (READ file) :STREAM stream :DEBUG-STREAM debug-stream :WAIT-TIME wait-time            :ASCII-TRANSLATE ascii-translate)))(DEFUN RUN-SCRIPT (script &KEY (stream *TERMINAL-IO*) (debug-stream *DEBUG-IO*) (wait-time 300.)   ascii-translate)  "Simulate an interactive user session with a script.SCRIPT is a list of the form ((SEND RECEIVE ACTION)...).SEND is a list of a format control string and its arguments that specify the output to be sent to STREAM.RECEIVE is a list of the time (in 60ths of a second - defaults to WAIT-TIME) to wait before executing  ACTION, a format control string and its arguments that specify the input expected from STREAM.ACTION specifies what to do if the data received doesn't contain the string specified by RECEIVE.  It can be a list of the form:  (:WAIT [<number>]), which will re-execute the RECEIVE portion of the clause <number> times, or forever                      if <number> is not supplied;  (:LOOP [<number>]), which will re-execute the entire clause <number> times, or forever if <number> is                      not supplied;  (:QUIT), the default, which will return NIL from RUN-SCRIPT;  (:QUIT :CLAUSE), which will advance to the next clause;  or another (SEND RECEIVE ACTION) clause.For each element of SCRIPT, first SEND is sent to STREAM, then STREAM is checked for input that matches  RECEIVE, if it is found, the next form is processed, else, the ACTION is processed, and STREAM is again  checked for input that matches RECEIVE.STREAM is an I/O stream.When DEBUG-STREAM is specified, it should be an I/O stream where debug info is sent.WAIT-TIME is the time, in 60ths of a second, to wait before timing out.  It can be overridden by the RECEIVE.When ASCII-TRANSLATE is non-NIL, translation between ASCII and Explorer characters is performed.RUN-SCRIPT returns T if the last RECEIVE in SCRIPT was successful, NIL otherwise."  (CHECK-ARG script LISTP "a list")  (CHECK-ARG stream STREAMP "a stream")  (CHECK-ARG debug-stream (OR (NULL debug-stream) (STREAMP debug-stream)) "a stream")  (DOLIST (clause script T)    (IF (NULL (PROCESS-CLAUSE clause stream debug-stream wait-time ascii-translate))(RETURN-FROM RUN-SCRIPT NIL))))(DEFUN PROCESS-CLAUSE (clause stream debug-stream wait-time ascii-translate)  (LET ((send (FIRST clause)) (receive (SECOND clause)) (action (THIRD clause)) (response2 nil))    (DO-FOREVER      (BLOCK SEND(WHEN send  (LET ((formatted-string (APPLY #'FORMAT NIL (FIRST send) (REST send))))    (WHEN debug-stream (FORMAT debug-stream "~%Sending:~A" formatted-string))    (SEND stream :STRING-OUT (IF ascii-translate (TRANSLATE-STRING-TO-ASCII formatted-string) formatted-string))))(IF receive    (UNWIND-PROTECT(PROGN  (WHEN (FIRST receive) (SETQ wait-time (FIRST receive)))  (LET ((formatted-string (APPLY #'FORMAT NIL (SECOND receive) (CDDR receive))))    (SETQ response2 (GET-RESPONSE-STRING))    (DO-FOREVER      (BLOCK RECEIVE(WHEN debug-stream (FORMAT debug-stream "~%Receiving:"))(DO ((char (SEND stream :TYI-WITH-TIMEOUT wait-time) (SEND stream :TYI-WITH-TIMEOUT wait-time)))    ((NULL char) T)  (WHEN (> char 0)    (VECTOR-PUSH-EXTEND (LOGAND char #o177) response2)    (WHEN debug-stream      (FORMAT debug-stream "~C" (IF ascii-translate    (TRANSLATE-CHAR-FROM-ASCII (LOGAND char #o177))    (LOGAND char #o177))))))(WHEN debug-stream  (FORMAT debug-stream "~%Searching for:~A" formatted-string))(IF (SEARCH (IF ascii-translate(TRANSLATE-STRING-TO-ASCII formatted-string)formatted-string)    response2)    (RETURN-FROM PROCESS-CLAUSE T)    (IF action(COND ((ATOM action) (FERROR NIL "The ACTION ~A of SCRIPT clause ~A is not a list."     action     clause))      ((EQ (FIRST action) :QUIT)        (IF (SECOND action)   (RETURN-FROM PROCESS-CLAUSE T);next clause   (RETURN-FROM PROCESS-CLAUSE NIL)));quit      ((EQ (FIRST action) :WAIT)       (IF (SECOND action)   (IF (< (SECOND action) 1)       (RETURN-FROM PROCESS-CLAUSE NIL);quit       (DECF (SECOND action))       (RETURN-FROM RECEIVE NIL));wait   (RETURN-FROM RECEIVE NIL)));wait      ((EQ (FIRST action) :LOOP)       (IF (SECOND action)   (IF (< (SECOND action) 1)       (RETURN-FROM PROCESS-CLAUSE NIL);quit       (DECF (SECOND action))       (RETURN-FROM SEND NIL));loop   (RETURN-FROM SEND NIL)));loop      (T (IF (PROCESS-CLAUSE action stream debug-stream wait-time ascii-translate)     (RETURN-FROM PROCESS-CLAUSE T)     (RETURN-FROM PROCESS-CLAUSE NIL))))(RETURN-FROM PROCESS-CLAUSE NIL)))))))      (RETURN-RESPONSE-STRING response2))    (RETURN-FROM PROCESS-CLAUSE T))))))  (DEFUN TRANSLATE-STRING-TO-ASCII (string)  (DOTIMES (i (LENGTH string) string)    (LET ((ch (AREF string i)))      (CASE (CHAR-CODE ch)(#.(CHAR-INT #\BACKSPACE) (SETF (AREF string i) 8))(#.(CHAR-INT #\TAB) (SETF (AREF string i) 9))(#.(CHAR-INT #\LINEFEED) (SETF (AREF string i) 10))(#.(CHAR-INT #\PAGE) (SETF (AREF string i) 12))(#.(CHAR-INT #\NEWLINE) (SETF (AREF string i) 13))(#.(CHAR-INT #\RUBOUT) (SETF (AREF string i) 127))))))(DEFUN TRANSLATE-CHAR-FROM-ASCII (ch)  (CASE (CHAR-CODE ch)    (8 #.(CHAR-INT #\BACKSPACE))    (9 #.(CHAR-INT #\TAB))    (10 #.(CHAR-INT #\LINEFEED))    (12 #.(CHAR-INT #\PAGE))    (13 #.(CHAR-INT #\NEWLINE))    (127 #.(CHAR-INT #\RUBOUT))    (T ch)))ystemThe features of the Explorer file system of greatest interest to Kermit usersare the form of the file specifications, and the distinctions between text andbinary files.Explorer file specifications are of the form:  HOST:DIRECTORY;NAME.TYPE#VERSIONHOST, if omitted, defaults to the local machine, DIRECTORY defaults to thelogged-on user's directory, and VERSION defaults to > (latest).  NAME.TYPEshould normally be provided, since the defaults may be difficult to predict.The host, directory, name, and type fields may contain any ASCII character,except control characters (like the carriage return).  The fields of the filespecification are set off from one another by the punctuation indicated above.Explorer Kermit transmits the pathname as specified by the user to the targetsystem, including host, device, and directory components.  If the target systemcannot handle all full pat