Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED "26-MAY-82 11:45:42" <LISPUSERS>PUPFTP.;5 22087
changes to: PUPFTP
previous date: "14-MAY-82 23:37:02" <LISPUSERS>PUPFTP.;4)
(* Copyright (c) 1981, 1982 by Xerox Corporation)
(PRETTYCOMPRINT PUPFTPCOMS)
(RPAQQ PUPFTPCOMS ((FNS PUPFTP READPLIST PRINLST PRINTPLIST CHECKEOC COPYCHARS PUPATMARKP GOBBLECHARS
PUPGETSTRING PUPGETMARK MTP CLOSEPUPFTP CHLNM SENDPUPABORT)
(VARS DIRFIELDS DELFIELDS (LASTTRACED))
(* for debugging)
(FNS PRINTPUPCODE PRINTPUPMARK PUPDEBUGCHECK)
(ADDVARS (REMOTEINFOLST (AUTHOR AUTHOR 11)
(LENGTH SIZE 9)
(SIZE SIZE 9)
(WRITEDATE WRITE-DATE 23)
(READDATE READ-DATE 23)
(CREATIONDATE CREATION-DATE 23)
(BYTESIZE BYTE-SIZE 9)
(TYPE TYPE 10)))
(DECLARE: EVAL@COMPILE (VARS MARKTYPES)
DONTCOPY
(PROP MACRO MARK# READMARK MARK CLEARMARK PUTCODE READCODE)
DONTEVAL@COMPILE
(TEMPLATES MARK# READMARK MARK CLEARMARK PUTCODE READCODE))
(BLOCKS (MTP MTP PRINLST COPYCHARS))
(FILES (FROM VALUEOF LISPUSERSDIRECTORIES)
STRINGFNS FTP PUPBSP)
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
FTP))))
(DEFINEQ
(PUPFTP
[LAMBDA (HOST FILE ACCESS USER PWD ACCT BYTESIZE)
(* lmm "26-MAY-82 11:45")
(RESETLST
(PROG (IN OUT CODE IJ OJ TEM PLIST CLOSEFORM LASTUSER (EOL (QUOTE CRLF))
(TYPE (QUOTE TEXT))
(FL FILE)
DF)
(SETQ LASTTRACED)
(SELECTQ BYTESIZE
((NIL 7))
(8 (SETQQ TYPE BINARY))
(ERROR BYTESIZE "invalid PUP bytesize"))
[SETQ ACCESS (SELECTQ ACCESS
((DELETE DELETE?)
(SETQ DF (CONS (QUOTE DIRECTORY)
DELFIELDS))
ACCESS)
(DIRECTORY (SETQ DF (CONS (QUOTE DIRECTORY)
DIRFIELDS))
ACCESS)
(LIST ACCESS)
((INPUT OUTPUT)
ACCESS)
(NIL (QUOTE INPUT))
(T (QUOTE OUTPUT))
(MAP (SETQ TYPE)
ACCESS)
(MAPSTORE (OR (SETQ FL (APPLY* FILE NIL OJ))
(RETURN))
(SETQ TYPE NIL)
ACCESS)
(COND
((LISTP ACCESS)
(SETQ DF (CDR ACCESS))
(CAR ACCESS))
(T (ERRORX (LIST 27 ACCESS]
[COND
((NOT USER)
[SETQ TEM (OR (CAR (GETHASH HOST LOGINPASSWORDS))
(CAR (GETHASH NIL LOGINPASSWORDS))
(LOGIN HOST (QUOTE QUIET]
(SETQ USER (CAR TEM))
(SETQ PWD (CDR TEM]
[SETQ OJ (OPNJFN (SETQ OUT (PUPOPENF NIL HOST (QUOTE FTP)
(QUOTE OUTPUT]
[SETQ IJ (OPNJFN (SETQ IN (PUPOPENF (JS CVSKT OJ NIL NIL 3)
HOST
(QUOTE FTP)
(QUOTE INPUT]
(RESETSAVE NIL (SETQ CLOSEFORM (LIST [FUNCTION (LAMBDA (IN OUT)
(COND
(RESETSTATE (SENDPUPABORT (OPNJFN OUT))
(CLOSEF? IN)
(CLOSEF? OUT]
IN OUT)))
(PROGN (MARK OJ (MARK# VERSION))
(PUTCODE OJ 1)
(MARK OJ (MARK# EOC)))
(SELECTC (PUPGETMARK IJ)
((MARK# VERSION)
(COND
((NEQ (READCODE IJ)
1)
(FTPHELP)))
(GOBBLECHARS IJ)
(OR (CHECKEOC IJ)
(FTPHELP)))
(FTPHELP))
AGAIN
[SETQ PLIST (CONS (LIST (QUOTE USER-NAME)
(SETQ LASTUSER USER))
(CONS (LIST (QUOTE USER-PASSWORD)
(OR PWD ""))
(OR (LISTP FL)
(LIST (LIST (QUOTE SERVER-FILENAME)
FL]
[COND
(TYPE (SETQ PLIST (CONS (LIST (QUOTE TYPE)
TYPE)
(COND
((EQ TYPE (QUOTE BINARY))
(* don't bother about EOL when output (i.e. let remote site default))
(CONS (LIST (QUOTE BYTE-SIZE)
BYTESIZE)
PLIST))
((NEQ ACCESS (QUOTE INPUT))
(* don't bother about EOL when output (i.e. let remote site default))
PLIST)
(T (CONS (LIST (QUOTE END-OF-LINE-CONVENTION)
EOL)
PLIST]
[COND
(DF (for X in DF when (LISTP X) do (push PLIST (LIST (QUOTE DESIRED-PROPERTY)
(CAR X]
PRINTPLIST
(PROGN (MARK OJ (SELECTQ ACCESS
((MAPSTORE OUTPUT)
(MARK# STORE))
((INPUT MAP)
(MARK# RETRIEVE))
((DIRECTORY LIST)
(MARK# DIRECTORY))
((DELETE DELETE?)
(MARK# DELETE))
(FTPHELP)))
(PRINTPLIST PLIST OJ)
[COND
(FTPDEBUGFLG (PRINTPLIST PLIST (OPNJFN FTPDEBUGFLG]
(MARK OJ (MARK# EOC)))
SELAC
(SELECTQ
ACCESS
(OUTPUT (SELECTC (PUPGETMARK IJ)
((MARK# YES)
(SETQ CODE (READCODE IJ))
(GOBBLECHARS IJ)
(CHECKEOC IJ)
(MARK OJ (MARK# HERE-IS-FILE))
(PUT OUT (QUOTE MATE)
IN)
(WHENCLOSE IN (QUOTE CLOSEALL)
(QUOTE NO))
(WHENCLOSE OUT (QUOTE BEFORE)
(FUNCTION CLOSEPUPFTP))
(SETFILEINFO OUT (QUOTE EOL)
EOL)
(RPLACA CLOSEFORM (FUNCTION NILL))
(RETURN (CHLNM FL HOST OUT PLIST T)))
((MARK# NO)
(GO GOTNO))
(FTPHELP)))
(MAPSTORE (SELECTC (PUPGETMARK IJ)
((MARK# YES)
(SETQ CODE (READCODE IJ))
(GOBBLECHARS IJ)
(CHECKEOC IJ)
(MARK OJ (MARK# HERE-IS-FILE))
(COND
((NOT (APPLY* FILE OUT))
(SENDPUPABORT OJ)
(GO RET)))
(MARK OJ (MARK# YES))
(PUTCODE OJ 0)
(COND
((NOT (SETQ FL (APPLY* FILE NIL OJ)))
(MARK OJ (MARK# EOC))
(GO RET)))
(GO AGAIN))
((MARK# NO)
(GO GOTNO))
(FTPHELP)))
(INPUT (SELECTC (PUPGETMARK IJ)
((MARK# HERE-IS-PLIST)
(SETQ PLIST (READPLIST IN))
(COND
(FTPDEBUGFLG (PRIN1 PLIST FTPDEBUGFLG)))
(CHECKEOC IJ)
(PROGN (MARK OJ (MARK# YES))
(PUTCODE OJ 0)
(MARK OJ (MARK# EOC)))
(SELECTC (PUPGETMARK IJ)
((MARK# HERE-IS-FILE)
(PUTPROP IN (QUOTE MATE)
OUT)
(PUTPROP IN (QUOTE PLIST)
PLIST)
(WHENCLOSE OUT (QUOTE CLOSEALL)
(QUOTE NO))
(WHENCLOSE IN (QUOTE BEFORE)
(FUNCTION CLOSEPUPFTP))
(SETFILEINFO IN (QUOTE EOL)
EOL)
(RPLACA CLOSEFORM (FUNCTION NILL))
(RETURN (CHLNM FL HOST IN PLIST)))
(FTPHELP)))
((MARK# NO)
(GO GOTNO))
((MARK# COMMENT)
(GO TRYEOL))
((MARK# EOC)
(GO AGAIN))
(FTPHELP)))
(MAP (SELECTC (PUPGETMARK IJ)
[(MARK# HERE-IS-PLIST)
(PROG NIL
LP (SETQ PLIST (READPLIST IN))
(COND
(FTPDEBUGFLG (PRIN1 PLIST FTPDEBUGFLG)))
(CHECKEOC IJ)
[COND
((BROWNIEUSEFILEP PLIST)
(MARK OJ (MARK# YES))
(PUTCODE OJ 0)
(MARK OJ (MARK# EOC))
(SELECTC (PUPGETMARK IJ)
((MARK# HERE-IS-FILE)
(BROWNIEUSEFILE IN PLIST)
(GOBBLECHARS IJ)
(SELECTC (PUPGETMARK IJ)
((MARK# YES)
(GOBBLECHARS IJ))
(FTPHELP)))
(FTPHELP)))
(T (PRODUCE NIL)
(MARK OJ (MARK# NO))
(PUTCODE OJ 0)
(MARK OJ (MARK# EOC]
(SELECTC (PUPGETMARK IJ)
((MARK# HERE-IS-PLIST)
(GO LP))
((MARK# EOC)
(GO RET))
(FTPHELP]
((MARK# NO)
(GO GOTNO))
((MARK# COMMENT)
(GO ABORT))
(FTPHELP))
(HELP))
((DIRECTORY LIST DELETE DELETE?)
(SELECTC (PUPGETMARK IJ)
((MARK# COMMENT)
(GOBBLECHARS IJ)
(GO SELAC))
[(MARK# HERE-IS-PLIST)
(RETURN
(PROG (LASTDIR TEM VAL)
LP (SETQ PLIST (READPLIST IN))
(SELECTQ ACCESS
(LIST (SETQ VAL (DOCOLLECT PLIST VAL)))
(PROGN (COND
([NEQ LASTDIR
(SETQ LASTDIR
(U-CASE (CADR (FASSOC (QUOTE DIRECTORY)
PLIST]
(PRIN1 "{" T)
(PRIN1 HOST T)
(PRIN1 "}<" T)
(PRIN1 LASTDIR T)
(PRIN1 ">
" T)))
[MAPC (OR (CDR DF)
DIRFIELDS)
(FUNCTION (LAMBDA (X)
(COND
((NLISTP X)
(PRIN1 X))
((SETQ TEM (CDR (FASSOC (CAR X)
PLIST)))
(TAB (CADR X)
(CADDR X)
T)
(MAPRINT TEM T]
(SELECTQ ACCESS
[(DELETE DELETE?)
(OR (CHECKEOC IJ)
(FTPHELP))
(COND
((OR (EQ ACCESS (QUOTE DELETE))
(EQ (QUOTE Y)
(ASKUSER NIL NIL "? " NIL T))
)
(MARK OJ (MARK# YES))
(PUTCODE OJ 0)
(MARK OJ (MARK# EOC))
(SELECTC (PUPGETMARK IJ)
((MARK# YES)
(GOBBLECHARS IJ))
(FTPHELP)))
(T (MARK OJ (MARK# NO))
(PUTCODE OJ 69)
(MARK OJ (MARK# EOC]
NIL)
(TAB 0 0 T)))
(SELECTC (PUPGETMARK IJ)
((MARK# HERE-IS-PLIST)
(GO LP))
((MARK# EOC)
(CLOSEF? IN)
(CLOSEF? OUT)
(RETURN (ENDCOLLECT VAL)))
(FTPHELP]
((MARK# NO)
(GO GOTNO))
(FTPHELP)))
(FTPHELP))
GOTNO
(SELECTQ (SETQ CODE (READCODE IJ))
((16 17) (* 16 = Illegal User-Name -
17 = Illegal or incorrect User-Password)
(GOBBLECHARS IJ)
(CHECKEOC IJ)
(SETQ TMP (LOGIN HOST T))
(SETQ USER (CAR TMP))
(SETQ PWD (CDR TMP))
(GO AGAIN))
((66 65) (* 66 = Transfer parameters inconsistent with file)
(GO TRYEOL))
(64 (SELECTQ ACCESS
(LIST (GOBBLECHARS IJ)
(GO RET))
(GO ABORT)))
(GO ABORT))
TRYEOL
(COND
((AND (EQ TYPE (QUOTE TEXT))
(EQ EOL (QUOTE CRLF)))
(SELECTQ ACCESS
(INPUT (SETQ EOL (QUOTE CR))
(GOBBLECHARS IJ)
(CHECKEOC IJ)
(GO AGAIN))
NIL)))
ABORT
(ERROR FL (CONCAT (PUPGETSTRING IN)))
RET (CLOSEF? IN)
(CLOSEF? OUT)
(RETURN])
(READPLIST
[LAMBDA (IN) (* lmm "26-APR-81 23:37")
(* should really be fixed to read in upper case of property names)
(PROG [(PLIST (READ (PUPGETSTRING IN)
(DEFERREDCONSTANT (PROG [(R (COPYREADTABLE (QUOTE ORIG]
(SETBRK (QUOTE (40 41))
NIL R)
(SETSYNTAX (QUOTE ')
(QUOTE ESCAPE)
R)
(SETSYNTAX (QUOTE %%)
(QUOTE OTHER)
R)
(SETSEPR (QUOTE (32 0))
NIL R)
(RETURN R]
[for PRP in PLIST do (RPLACA PRP (AND (CAR PRP)
(OR (GETPROP (CAR PRP)
(QUOTE U-CASE))
(PUTPROP (CAR PRP)
(QUOTE U-CASE)
(U-CASE (CAR PRP]
(RETURN PLIST])
(PRINLST
[LAMBDA (X FL) (* lmm " 9-JAN-81 15:27")
(PRIN3 (CAR X)
FL)
(COND
((CDR X)
(PRIN3 " " FL)
(PRINLST (CDR X)
FL])
(PRINTPLIST
(LAMBDA (L OJ) (* lmm "24-SEP-78 03:20")
(JS BOUT OJ (CONSTANT (CHCON1 "(")))
(MAPC L (FUNCTION (LAMBDA (X)
(PROG ((PRE (CONSTANT (CHCON1 "("))))
(MAPC X (FUNCTION (LAMBDA (XL)
(JS BOUT OJ PRE)
(SETQ PRE (CONSTANT (CHCON1 " ")))
(ASSEMBLE NIL
(CQ (MKSTRING XL))
(FASTCALL UPATM)
(JUMPE 4 , OUT)
LP (CV OJ)
(ILDB 2 , 3)
(CAIE 2 , (CHCON1 "("))
(CAIN 2 , (CHCON1 ")"))
(JRST Q)
(CAIN 2 , (CHCON1 "'"))
(JRST Q)
DOB (JS BOUT)
(SOJG 4 , LP)
(JRST OUT)
Q (PUSHN 2)
(MOVEI 2 , (CHCON1 "'"))
(JS BOUT)
(POPN 2)
(JRST DOB)
OUT)))))
(JS BOUT OJ (CONSTANT (CHCON1 ")"))))))
(JS BOUT OJ (CONSTANT (CHCON1 ")")))
NIL))
(CHECKEOC
[LAMBDA (IN) (* lmm "26-APR-81 23:42")
(OR (PUPATMARKP IN)
(FTPHELP))
(COND
((EQ (READMARK IN)
(MARK# EOC))
(PRINTPUPMARK (MARK# EOC)
(QUOTE S))
(CLEARMARK IN)
T])
(COPYCHARS
[LAMBDA (IJ OJ) (* lmm " 9-JAN-81 15:50")
(ASSEMBLE NIL
(PUSHN 2)
CIN (CV IJ)
(JS BIN)
(NREF (MOVEM 2 , 0))
(JUMPN 2 , COUT)
(JS GDSTS)
(TLNE 2 , 20000Q)
(JUMPA OUT)
COUT(CV OJ)
(NREF (MOVE 2 , 0))
(JS BOUT)
(CAIE 2 , (CHARCODE CR))
(JUMPA CIN)
(MOVEI 2 , (CHARCODE LF))
(JS BOUT)
(JUMPA CIN)
OUT (POPN 2])
(PUPATMARKP
[LAMBDA (IN) (* lmm "10-APR-78 16:19")
(COND
((ZEROP (JS BIN IN NIL NIL 2))
(BIT 4 (JS GDSTS IN 0 0 2)))
(T (JS BKJFN IN)
NIL])
(GOBBLECHARS
[LAMBDA (IN) (* lmm "26-APR-81 23:42")
(PROG NIL
(COND
[FTPDEBUGFLG (PROG (CH)
(PUPDEBUGCHECK (QUOTE S))
LP (COND
([OR (NEQ (SETQ CH (JS BIN IN NIL NIL 2))
0)
(NOT (BIT 4 (JS GDSTS IN 0 0 2)]
(PRIN3 (CHARACTER CH)
FTPDEBUGFLG)
(GO LP]
(T (ASSEMBLE NIL
CIN (CV IN)
DOB (JSYS 50Q)
(JUMPN 2 , DOB)
(JS GDSTS)
(TLNN 2 , 20000Q)
(JUMPA CIN])
(PUPGETSTRING
[LAMBDA (IN UCASE) (* lmm "22-APR-81 00:52")
(PROG [(STR (STRINGFROMFILE IN (DUMMYSTRING]
(OR (EOFP IN)
(FTPHELP "PLIST too long"))
(COND
(FTPDEBUGFLG (PRIN3 STR FTPDEBUGFLG)))
(COND
(UCASE (UCASESTRING STR)))
(RETURN STR])
(PUPGETMARK
[LAMBDA (IJ) (* lmm "26-APR-81 23:42")
(OR (PUPATMARKP IJ)
(FTPHELP))
(PROG1 (PRINTPUPMARK (READMARK IJ)
(QUOTE S))
(CLEARMARK IJ])
(MTP
[LAMBDA (HOST TOFILE USER PWD MAILBOX)
(* lmm "26-APR-81 23:41")
(RESETLST (PROG (TMPFILE OJ IJ IN OUT CLOSEFORM PLIST LASTUSER CODE (N 0))
(SETQ LASTTRACED)
(OR USER (SETQ USER (USERNAME)))
[SETQ OJ (OPNJFN (SETQ OUT (PUPOPENF NIL HOST (QUOTE MAIL)
(QUOTE OUTPUT]
[SETQ IJ (OPNJFN (SETQ IN (PUPOPENF (JS CVSKT OJ NIL NIL 3)
HOST
(QUOTE MAIL)
(QUOTE INPUT]
(RESETSAVE NIL (SETQ CLOSEFORM (LIST [FUNCTION (LAMBDA (IN OUT)
(COND
(RESETSTATE (SENDPUPABORT
(OPNJFN OUT))
(CLOSEF? IN)
(CLOSEF? OUT]
IN OUT)))
(* PROGN (MARK OJ (MARK# VERSION)) (PUTCODE OJ 1)
(MARK OJ (MARK# EOC)))
AGAIN
[SETQ PLIST (LIST (LIST (QUOTE USER-NAME)
(SETQ LASTUSER USER))
(LIST (QUOTE USER-PASSWORD)
(OR PWD (GETPASSWORD USER)))
(LIST (QUOTE MAILBOX)
(OR MAILBOX USER]
PRINTPLIST
(PROGN (MARK OJ (MARK# RETRIEVE-MAIL))
(PRINTPLIST PLIST OJ)
[COND
(FTPDEBUGFLG (PRINTPLIST PLIST (OPNJFN FTPDEBUGFLG]
(MARK OJ (MARK# EOC)))
(SETQ TOFILE (OPENFILE TOFILE (QUOTE OUTPUT)))
(SETQ TMPFILE (OPENFILE (QUOTE TMP;T)
(QUOTE BOTH)
(QUOTE OLD/NEW)))
(do (SELECTC (PUPGETMARK IJ)
((MARK# HERE-IS-PLIST)
(add N 1)
(SETQ PLIST (READPLIST IN))
(COND
(FTPDEBUGFLG (PRIN1 PLIST FTPDEBUGFLG)))
(SELECTC (PUPGETMARK IJ)
((MARK# HERE-IS-FILE)
(SETFILEPTR TMPFILE 0)
(COPYCHARS IJ (OPNJFN TMPFILE))
(PRINLST (CDR (FASSOC (QUOTE DATE-RECEIVED)
PLIST))
TOFILE)
(PRIN3 "," TOFILE)
(PRIN3 (GETFILEPTR TMPFILE)
TOFILE)
(PRIN3 ";00000000000" TOFILE)
(PRIN3 (IPLUS (COND
((EQ (CADR (FASSOC (QUOTE OPENED)
PLIST))
(QUOTE YES))
1)
(T 0))
(COND
((EQ (CADR (FASSOC (QUOTE DELETED)
PLIST))
(QUOTE YES))
2)
(T 0)))
TOFILE)
(TERPRI TOFILE)
(COPYBYTES TMPFILE TOFILE 0 (GETFILEPTR TMPFILE)))
(FTPHELP)))
((MARK# YES)
(GO RET))
((MARK# NO)
(GO GOTNO))
(FTPHELP)))
GOTNO
(SELECTQ (SETQ CODE (READCODE IJ))
((16 17)
(* 16 = Illegal User-Name -
17 = Illegal or incorrect User-Password)
(GOBBLECHARS IJ)
(CHECKEOC IJ)
[COND
[(OR (EQ CODE 16)
PWD)
(PRIN1 "login at " T)
(PRIN1 HOST T)
(PRIN1 " as user: " T)
(RESETBUFS (SETQ USER (READ T)))
(SETQ PWD (AND (EQ USER LASTUSER)
(GETPASSWORD USER T]
(T
(* user might be ok, but password not given)
(SETQ PWD (GETPASSWORD USER]
(GO AGAIN))
(GO ABORT))
ABORT
(ERROR (CONCAT (PUPGETSTRING IN)))
RET (CLOSEF? IN)
(CLOSEF? OUT)
(AND TMPFILE (CLOSEF TMPFILE))
(RETURN (CLOSEF TOFILE])
(CLOSEPUPFTP
[LAMBDA (FILE) (* lmm "26-APR-81 23:41")
(PROG ((MATE (GETPROP FILE (QUOTE MATE)))
(OJ (OPNJFN FILE)))
(REMPROP FILE (QUOTE MATE))
(REMPROP FILE (QUOTE PLIST))
(COND
((OPENP FILE (QUOTE OUTPUT))
(MARK OJ (MARK# YES))
(PUTCODE OJ 0)
(MARK OJ (MARK# EOC))
(AND MATE (CLOSEF? MATE)))
((AND MATE (OPENP MATE))
(SENDPUPABORT OJ)
(CLOSEF MATE])
(CHLNM
(LAMBDA (FILE HOST F1 PLIST OUTFLG) (* lmm "18-OCT-78 01:55")
(CHANGEFILENAME F1 (PACK* "{" HOST "}" (OR (CADR (FASSOC (QUOTE SERVER-FILENAME)
PLIST))
FILE))
OUTFLG)))
(SENDPUPABORT
[LAMBDA (OJ) (* lmm "18-OCT-78 15:43")
(* send an ABORT)
(ASSEMBLE NIL
(CV OJ)
(MOVEI 2 , 0)
(JS GTSTS)
(TLNE 2 , 1400Q)
(JRST OUT)
(MOVEI 2 , 25Q)
(MOVEI 3 , 0)
(MOVEI 4 , 0)
(JS MTOPR)
OUT])
)
(RPAQQ DIRFIELDS ((NAME-BODY 0 0)
";"
(VERSION 0 T)
(WRITE-DATE 30 1)))
(RPAQQ DELFIELDS ("delete " (NAME-BODY 0 T)
";"
(VERSION 0 T)))
(RPAQQ LASTTRACED NIL)
(* for debugging)
(DEFINEQ
(PRINTPUPCODE
[LAMBDA (CODE FROM) (* lmm "26-APR-81 23:42")
(COND
(FTPDEBUGFLG (PUPDEBUGCHECK FROM)
(RADIX 8)
(PRIN1 "<" FTPDEBUGFLG)
(PROG1 (PRIN2 CODE FTPDEBUGFLG)
(PRIN1 "> " FTPDEBUGFLG))
(RADIX 10)))
CODE])
(PRINTPUPMARK
[LAMBDA (N FROM) (* lmm "26-APR-81 23:42")
(COND
(FTPDEBUGFLG (PUPDEBUGCHECK FROM)
(PRIN1 "[" FTPDEBUGFLG)
(PRIN1 (L-CASE (CADR (FASSOC N MARKTYPES)))
FTPDEBUGFLG)
(PRIN1 "]" FTPDEBUGFLG)))
N])
(PUPDEBUGCHECK
[LAMBDA (WHO) (* lmm "11-APR-78 04:37")
(AND FTPDEBUGFLG (COND
((NEQ LASTTRACED (SETQ LASTTRACED WHO))
(TAB 0 0 FTPDEBUGFLG)
(PRIN1 WHO FTPDEBUGFLG)
(PRIN1 ": " FTPDEBUGFLG])
)
(ADDTOVAR REMOTEINFOLST (AUTHOR AUTHOR 11)
(LENGTH SIZE 9)
(SIZE SIZE 9)
(WRITEDATE WRITE-DATE 23)
(READDATE READ-DATE 23)
(CREATIONDATE CREATION-DATE 23)
(BYTESIZE BYTE-SIZE 9)
(TYPE TYPE 10))
(DECLARE: EVAL@COMPILE
(RPAQQ MARKTYPES ((1 RETRIEVE)
(2 STORE)
(3 YES)
(4 NO)
(5 HERE-IS-FILE)
(6 EOC)
(7 COMMENT)
(8 VERSION)
(10 DIRECTORY)
(11 HERE-IS-PLIST)
(13 ABORT)
(14 DELETE)
(16 STORE-MAIL)
(17 RETRIEVE-MAIL)
(18 FLUSH-MAILBOX)
(19 MAILBOX-EXCEPTION)
(? NEWSTORE)))
DONTCOPY
(PUTPROPS MARK# MACRO [X (CAAR (OR [SOME MARKTYPES (FUNCTION (LAMBDA (L)
(MEMB (CAR X)
(CDR L]
(HELP (CAR X)
(QUOTE MARK#])
(PUTPROPS READMARK MACRO ((JFN)
(JS MTOPR JFN 23Q NIL 3)))
(PUTPROPS MARK MACRO [(JFN #)
(JS MTOPR JFN 3 (PRINTPUPMARK # (QUOTE U)))])
(PUTPROPS CLEARMARK MACRO ((JFN)
(ASSEMBLE NIL
(CV JFN)
(MOVEI 2 , 0)
(MOVEI 3 , 0)
(JS GDSTS)
(TLZ 2 , 30000Q)
(JS SDSTS))))
(PUTPROPS PUTCODE MACRO [(OJ CODE)
(JS BOUT OJ (PRINTPUPCODE CODE (QUOTE U)))])
(PUTPROPS READCODE MACRO ((IJ)
(PRINTPUPCODE (JS BIN IJ NIL NIL 2)
(QUOTE S))))
DONTEVAL@COMPILE
(SETTEMPLATE (QUOTE MARK#)
(QUOTE MACRO))
(SETTEMPLATE (QUOTE READMARK)
NIL)
(SETTEMPLATE (QUOTE MARK)
(QUOTE MACRO))
(SETTEMPLATE (QUOTE CLEARMARK)
NIL)
(SETTEMPLATE (QUOTE PUTCODE)
(QUOTE MACRO))
(SETTEMPLATE (QUOTE READCODE)
(QUOTE MACRO))
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: MTP MTP PRINLST COPYCHARS)
]
(FILESLOAD (FROM VALUEOF LISPUSERSDIRECTORIES)
STRINGFNS FTP PUPBSP)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
FTP)
)
(DECLARE: DONTCOPY (PUTPROPS PUPFTP COPYRIGHT ("Xerox Corporation" 1981 1982)))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1230 19022 (PUPFTP 1242 . 10472) (READPLIST 10476 . 11302) (PRINLST 11306 . 11489) (
PRINTPLIST 11493 . 12476) (CHECKEOC 12480 . 12735) (COPYCHARS 12739 . 13217) (PUPATMARKP 13221 . 13419
) (GOBBLECHARS 13423 . 13976) (PUPGETSTRING 13980 . 14315) (PUPGETMARK 14319 . 14523) (MTP 14527 .
17913) (CLOSEPUPFTP 17917 . 18404) (CHLNM 18408 . 18653) (SENDPUPABORT 18657 . 19019)) (19266 20104 (
PRINTPUPCODE 19278 . 19564) (PRINTPUPMARK 19568 . 19847) (PUPDEBUGCHECK 19851 . 20101)))))
STOP