Trailing-Edge
-
PDP-10 Archives
-
BB-5255D-BM
-
4-sources/ftpser.mac
There are 4 other files named ftpser.mac in the archive. Click here to see a list.
;<4.ARPA-UTILITIES>FTPSER.MAC.9, 4-Jan-80 09:46:18, EDIT BY R.ACE
;UPDATE COPYRIGHT DATES
;<4.ARPA-UTILITIES>FTPSER.MAC.8, 11-Oct-79 11:35:30, Edit by LCAMPBELL
; Update version and edit numbers for release 4
;<4.ARPA-UTILITIES>FTPSER.MAC.7, 10-Oct-79 09:37:16, Edit by LCAMPBELL
; Ctrl-V the lowercase stuff in "somebody at " message
;<4.ARPA-UTILITIES>FTPSER.MAC.6, 28-Sep-79 11:42:11, Edit by LCAMPBELL
; Lowercase "mail will be forwarded" message
;<4.ARPA-UTILITIES>FTPSER.MAC.5, 24-Sep-79 14:45:10, Edit by LCAMPBELL
; Set last writer of MAIL.TXT to "Somebody at <hostname>"
;<4.ARPA-UTILITIES>FTPSER.MAC.4, 13-Jul-79 16:53:45, Edit by LCAMPBELL
; Release 4 fix (clear bit 200 at TELBIN)
;<4.ARPA-UTILITIES>FTPSER.MAC.3, 10-Jul-79 05:29:42, EDIT BY R.ACE
;UPDATE COPYRIGHT NOTICE
;<4.ARPA-UTILITIES>FTPSER.MAC.2, 27-Apr-79 11:45:16, Edit by LCAMPBELL
; New Telnet fix
;<HACKS>FTPSER.MAC.8, 1-Jun-78 23:00:29, EDIT BY JBORCHEK
;TRY TO USE THE DEFAULT ACCOUNT IF YOU CAN
;<HACKS>FTPSER.MAC.3, 1-Jun-78 21:54:41, EDIT BY JBORCHEK
;NEVER ASSUME NUMERIC ACCOUNTS
;<JBORCHEK>FTPSER.MAC.2, 24-Apr-78 13:24:10, EDIT BY JBORCHEK
;CHANGE TTY TYPE TO 9 AND SET TO BINARY NO ECHO MODE
;INT ON QUOTA EXCEEDED. DATA ERRORS NOW CLOSE CONN.
;<3.ARPA-UTILITIES>FTPSER.MAC.5, 14-Nov-77 10:18:49, EDIT BY CROSSLAND
;CORRECT COPYRIGHT NOTICE
;<3.ARPA-UTILITIES>FTPSER.MAC.4, 26-Oct-77 02:36:41, EDIT BY CROSSLAND
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-UTILITIES>FTPSER.MAC.3, 30-Sep-77 11:07:44, EDIT BY CROSSLAND
;<3-UTILITIES>FTPSER.MAC.2, 20-Jun-77 22:15:47, EDIT BY CROSSLAND
;CONVERT TO MULTIPLE STRUCTURES
;<101B-SOURCES>FTPSER.MAC.2, 1-Apr-77 15:52:33, EDIT BY CROSSLAND
;ADD JFCL'S AFTER RFBSZ'S FOR TOPS-20
;^V QUOTE UNSENT MAIL
;<A-UTILITIES>FTPSER.MAC.7, 3-Dec-76 15:53:46, EDIT BY CLEMENTS
; CONDITION OUT IPCF REPORT - NO TIME TO FINISH IT.
;<A-UTILITIES>FTPSER.MAC.6, 23-Nov-76 15:05:25, EDIT BY CLEMENTS
;ADD SFCOC TO ALL "2" AT STARTUP - FIXES ^L IN MAIL SCREWUP
;ADD IPCF REPORTING TO FTSCTL
; CHANGE MAIL FILE NAME FROM MESSAGE.TXT TO MAIL.TXT
; REMOVE XLPTF COMMAND
; REMOVE FILTERING OF FORMFEEDS FROM MAIL
;<2MURPHY>FTPSER.MAC.2, 16-Jul-76 17:18:32, EDIT BY MURPHY
;CHANGE STENEX TO MONSYM,MACSYM
;<SOURCES>FTPSER.MAC;56 23-Apr-76 16:06:11 EDIT BY CLEMENTS
; Add XLPTF command. Prevent autologout sometimes. DEBUG ok if wheel.
;<SOURCES>FTPSER.MAC;55 15-OCT-75 13:39:55 EDIT BY CLEMENTS
; Changed timeout logic to not hang up if logged in.
;<SOURCES>FTPSER.MAC;54 8-OCT-75 14:52:32 EDIT BY CLEMENTS
; REMOVE CHECK FOR FILE BEING OPEN AT TELBIN, SINCE IT FAILS FOR
; PRIMARY JFN WHEN IT'S A TTY. WAS CAUSING NULLS TO ABORT MAIL.
;<SOURCES>FTPSER.MAC;53 22-SEP-75 13:06:40 EDIT BY CLEMENTS
;<CLEMENTS>FTPSER.MAC;52 24-JUL-75 18:35:38 EDIT BY CLEMENTS
; STTYP OF 0 AT STARTUP, CLEAR ADVICE AT STARTUP
;<CLEMENTS>FTPSER.MAC;51 16-JUL-75 17:53:20 EDIT BY CLEMENTS
; Repaginated
;<CLEMENTS>FTPSER.MAC;50 16-JUL-75 16:48:28 EDIT BY CLEMENTS
; Make CWD try to do a CNDIR; Make PASS after CWD do CNDIR if needed.
;<CLEMENTS>FTPSER.MAC;49 16-JUL-75 13:46:54 EDIT BY CLEMENTS
; Make ACCT command legal after already logged in. Does CACCT.
;<CLEMENTS>FTPSER.MAC;48 11-JUL-75 14:51:40 EDIT BY CLEMENTS
;<CLEMENTS>FTPSER.MAC;47 10-JUL-75 13:00:04 EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;46 9-JUL-75 17:41:04 EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;45 9-JUL-75 17:29:28 EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;44 9-JUL-75 16:17:06 EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;43 9-JUL-75 13:24:59 EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;42 5-JUL-75 23:52:38 EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;41 5-JUL-75 23:08:20 EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;40 5-JUL-75 22:55:46 EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;39 5-JUL-75 17:16:26 EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;37 3-JUL-75 14:26:21 EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;36 3-JUL-75 13:27:09 EDIT BY CLEMENTS
; ADD THE FILE ACTIVITY COMMANDS
;<CLEMENTS>FTPMSV.MAC;35 3-JUL-75 00:01:20 EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;34 2-JUL-75 23:27:21 EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;31 30-JUN-75 15:11:59 EDIT BY CLEMENTS
; Initial development continuing
;This software is furnished under a license and may only be used
; or copied in accordance with the terms of such license.
;
;Copyright (C) 1976,1977,1978,1979,1980 by Digital Equipment Corporation, Maynard, Mass.
TITLE FTPSER - FTP server. New CRJOB style
;STARTED UP BY FTSCTL.EXE SYSTEM JOB
VWHO==0 ;LAST EDITED BY DEC
VMAJOR==4 ;MAJOR VERSION #
VMINOR==0 ;REVISION #
VEDIT==^D16
LOC <.JBVER==137>
VERSIO: <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT ;VERSIONS FOR TYPEOUT
RELOC
TWOSEG ;THE HIGH SEG CONTAINS CODE USED AFTER LOGIN
RELOC 400000 ;CREATE THE HIGH SEG
SEARCH MONSYM,MACSYM
SALL
;AC DEFINITIONS
F=:0 ;FLAGS
A=:1 ;A-D ARE JSYS ARGS
B=:2
C=:3
D=:4
T1=:5 ;TEMPS
T2=:6
P1=:7 ;PERMANENT OVER SUBR CALLS
P2=:10
P3=:11
BP=:14 ;BYTE POINTER FOR COLLECTING, PARSING STRINGS
X=:15 ;MSG POINTER IN MAIL ERRORS
P=:17 ;STACK
;PARAMETERS
PDLL==40 ;LENGTH OF STACK
TIMCHN==^D24 ;CHANNEL POKED BY TIMING FORK EVERY NOW AND THEN
CTCCHN==^D25 ;CHANNEL FOR CONTROL C
DETCHN==^D26 ;CHANNEL FOR NVT HANGUP
LCMDIB==^D512 ;WORDS TO HOLD TELNET LINE. MAKE RIDICULOUSLY HUGE
;BECAUSE OF NLS USERS' INABILITY TO TYPE CARRIAGE RETURN
LREPLY==^D100 ;WORDS TO HOLD REPLY. SHOULDN'T NEED NEARLY THIS MUCH
WATTIM==^D300 ;SECONDS TO WAIT FOR USER TO TYPE SOMETHING
MLSKT==^D232 ;FOREIGN SOCKET FROM WHICH COMES AUTHENTICATED
; MAIL IF WE TRUST THE SITE
IFNDEF IPCLOG,<
IPCLOG==0 ;RUDIMENTARY LOGGING VIA IPCF,
; NOT YET IMPLEMENTED
>
DEFINE CLOSE (FILE)< MOVEI A,FILE
PUSHJ P,CLOSER
>
DEFINE CLOSK (FILE)< MOVEI A,FILE
PUSHJ P,CLOSEK
>
LOC 2000 ;ORIGIN OF CODE IN LOW SEGMENT
;FLAGS IN AC F
L.SEND==400000 ;DISTINGUISH DATA SENDS FROM RECEIVES
L.CMDK==200000 ;ERRRPL SETS THIS. CAUSES GETCOM TO HANG UP.
L.LTL==100000 ;LINEIN SETS THIS. LINE WAS RIDICULOUSLY LONG.
L.LICV==040000 ;SET IN LINEIN WHEN ^V SEEN
L.MLFL==020000 ;DISTINGUISH MAIL FROM MLFL
L.ANON==010000 ;ANONYMOUS LOGIN
L.NUMA==004000 ;FLAG NON-NUMERIC STRING IN ACCOUNT COMMAND
L.MFWD==002000 ;MAIL WILL BE FORWARDED
L.LOGI==001000 ;I AM LOGGED IN
L.APPE==000400 ;APPEND VERSUS STOR
L.LDSK==000200 ;LOCAL FILE IS ON DISK
L.STAT==000100 ;STAT VERSUS LIST
L.NALO==000020 ;DON'T AUTO-LOGOUT THIS JOB.
L.RNIL==000010 ;RETRIEVE A MEGABIT FROM NIL:
L.PDIR==000004 ;PRINT DIRECTORY NAME, IN LIST AND STAT
L.ACTV==000002 ;FILE ACTIVITY GOING ON
L.ABOR==000001 ;ABORT REQUEST RECEIVED DURING FILE ACTIVITY
R.RLPT==1 ;ON IF RECEIVING FOR SPOOLED LPT
R.TYPX==2 ;ON WHEN RETR OR STOR IS PAGED FILE TYPE (XTP)
R.T1==4 ;TEMPS USED IN DIRECTORY LISTING ROUTINE
R.T2==10 ; ..
R.NLST==20 ;DISTINGUISH LIST FROM NLST
;START ADDRESS OF THE TOP LEVEL OF FTP SERVICE
GO: RESET ;START HERE, CLEAN SLATE
MOVE P,PDP ;SET UP A STACK
MOVEI F,0 ;INITIALIZE ALL FLAGS TO ZERO
MOVE A,['FTPSER'] ;SET NAME TO THIS FOR ACCOUNTING
SETNM
MOVEI A,400 ;REMOVE ACCESS TO HIGH SEGMENT
PUSH P,A ; WHERE THE FILE ACTIVITY CODE IS
GOSPLP: MOVSI A,400000 ;PAGE IN THIS FORK
HRR A,0(P) ;HERE IN THE ADDRESS SPACE
RPACS ;SEE IF THE PAGE EXISTS
TLNN B,(1B5) ; ..
JRST GONXTP ;NO SUCH PAGE. SEE IF ANY MORE.
MOVSI B,(1B8) ;ACCESS TO NONE, BUT TRAP IF REFERENCED
SPACS ; ..
GONXTP: AOS B,0(P) ;ON TO NEXT PAGE
CAIGE B,700 ;UP TO DDT?
JRST GOSPLP ;NO, DISCARD ANOTHER ONE
POP P,(P) ;DISCARD PAGE NUMBER
GJINF ;SEE WHAT MY CONDITION IS
MOVEM A,GJINF1 ;AND SAVE FOR LATER
MOVEM B,GJINF2
MOVEM C,GJINF3
MOVEM D,GJINF4
SKIPN A ;AM I LOGGED IN ALREADY?
TLZA F,L.LOGI ;NO
TLO F,L.LOGI ;YES.
TLNE F,L.LOGI ;IF LOGGED IN,
PUSHJ P,GETHI ;MAP THE HIGH SEG BACK IN, UNWRITABLE.
JUMPGE D,INIT1 ;JUMP IF I'M ATTACHED.
SETO A,0 ;NOT. LOG OUT IF NOT LOGGED IN
SKIPN GJINF1 ;LOGGED IN DIRECTORY?
PUSHJ P,LOGOUT ;NONE. KILL OFF JOB
JFCL
MOVEI A,101 ;POINT TO THE CONTROLLING TTY
DOBE ;THIS WILL HANG UNTIL ATTACHED
JRST GO ;AND GO TRY AGAIN.
INIT1: MOVEI A,400000 ;GET CAPABILITIES
RPCAP ;SO CAN ENABLE CONTROL C,
IOR C,B ;AND DELIVER MAIL
EPCAP ; ..
PUSHJ P,TIMEOK ;SET UP INITIAL TIME BEFORE PSI IS ON
SETOM TFORKX ;NO TIMING FORK YET
MOVEI A,100 ;SET NVT TYPE TO 9
MOVEI B,9
STTYP
MOVE B,[7B3+10B23+3B33] ;TAB,FF,LC,WAKE ON CR,LINE HALF DUPLEX
SFMOD
STPAR
MOVE B,[BYTE (2)2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2]
MOVE C,B
SFCOC ;MAKE SURE NO GRAPHICS ECHOED ON CTRLS
HRLOI A,(1B4+0B5+1B0+1B1)
MOVEI B,-1 ;REFUSE AND BREAK LINKS
TLINK ; ..
PUSHJ P,BOMB
repeat 0,< ;dec adviz is in tlink
MOVE A,GJINF4 ;TERMINAL NUMBER
TRO A,400000 ;DESIGNATOR
HRLI A,(1B0) ;CLEAR ADVICE
ADVIZ ; ..
PUSHJ P,BOMB
>
SETZM $TYPE ;INITIALIZE ALL PARAMS TO DEFAULT
SETZM $MODE ;FOR FILE CONNECTION AND SO ON
MOVEI A,10 ;DEFAULT BYTE SIZE
MOVEM A,$BYTE ; ..
SETZM $STRU ; ..
SETOM $PATH1 ;JFN'S SET TO -1
SETOM $PATH2 ; ..
SETOM $SOCK
SETOM $HOST
SETOM DATJFN ;NO DATA CONNECTION OPEN YET
;FALL THRU
;FALLS THRU INTO HERE
INIT2: SETZM USRFCT ;NO BAD USER NAMES YET
SETZM PASFCT ;NO PASSWORD FAILURES YET.
SETZM USERNM ;USER NUMBER HAS NOT BEEN DECLARED YET
SETZM $CWD ;NO CWD ARGUMENT YET
SETOM $ACCES+2 ;ALWAYS CONNETING THIS JOB
SETZM PRVKWD ;NO PREVIOUS KEYWORD YET,
SETZM KEYWRD ; AND NO CURRENT ONE EITHER.
SETOM LGOCNT ;INIT LOGOUT FORCER COUNTER
SETOM LCLJFN ;CLEAR JFN'S USED LATER
SETOM DATJFN ; ..
SETOM LOGJFN ; ..
SETZM MYPID ;I HAVE NO PID YET
SETZM ANODNO ;SEE IF ANONYMOUS IS A USER
MOVX A,RC%EMO ;EXACT MATCH ONLY
HRROI B,[ASCIZ /ANONYMOUS/]
RCUSR ;DOES THIS USER EXIST?
TXNE A,<RC%NOM!RC%AMB> ;DOES IT EXIST
JRST .+2 ;LEAVE ANONYMOUS DIRECTORY NUMBER AS 0
MOVEM C,ANODNO ;YES, STORE THE DIRECTORY NUMBER
SETZM SYSDNM ;SEE WHAT SYSTEM'S DIR NUM IS
MOVX A,RC%EMO ;EXACT MATCH ONLY
HRROI B,[ASCIZ /PS:<SYSTEM>/]
RCDIR
MOVEM C,SYSDNM ;STORE IT
MOVE A,['LHOSTN']
SYSGT ;GETAB TABLE NUMBER FOR LOCAL HOST
JUMPE B,HANGUP ;GOTTA HAVE IT
MOVEM A,LHOSTN ;SAVE HOST NUMBER
MOVE A,B ;AND GET THE NVT RANGE
HRLI A,1 ; ..
GETAB
JRST HANGUP ;GOTTA HAVE THAT TOO
HLRE B,A ;MINUS NUMBER OF NVT'S
MOVE C,GJINF4 ;TTY I AM ON
HRRZ A,A ;FIRST NVT
MOVMS B ;COMPUTE LAST NVT
ADDI B,-1(A) ;..
CAML C,A ;AM I ON AN NVT?
CAMLE C,B ; ..
JRST NOTNVT ;NO.
;FALL THRU
;FALLS THRU FROM ABOVE. FIND OUT THE DATA ABOUT THIS NVT
WHTNVT: MOVE A,['NETSTS'] ;OK, FIND OUT WHO HAS CALLED IN.
SYSGT ;WHICH REQUIRES SCANNING SOME TABLES.
MOVEM B,NSTSN ;SAVE THE POINTER
MOVE A,['NETBUF'] ;ANOTHER ONE
SYSGT
MOVEM B,NBUFN ; ..
HLLZ X,B ;LOOP THRU TABLES
INITL3: MOVSI A,(X) ;TABLE INDEX
HRR A,NSTSN ;GET CONNECTION STATE
GETAB
JRST HANGUP ;CAN'T FAIL
ROT A,4 ;CONNECTION STATE
ANDI A,17 ;FOUR BIT STATE
CAIE A,7 ;IS IT OPENED?
JRST INITX3 ;NO
MOVSI A,(X) ;YES. SEE IF CONNECTED TO THIS TTY
HRR A,NBUFN ; ..
GETAB
JRST HANGUP ;CAN'T FAIL
CAMN A,GJINF4 ;THIS TTY?
JRST FNDNVT ;FOUND THE NVT
INITX3: AOBJN X,INITL3 ;KEEP LOOKING
JRST HANGUP ;NOT FOUND!
FNDNVT: HRRZM X,NETSKX ;SAVE THE INDEX
MOVE A,['NETLSK'] ;GET THE DATA ABOUT THIS NVT'S CONNECTIONS
SYSGT
MOVE A,B
HRL A,X
GETAB
0
TRZ A,1 ;SAVE THE EVEN NUMBERED SOCKET
MOVEM A,NETLSK ;LOCAL SOCKET NUMBER
MOVE A,['NETFSK'] ;NOW GET THE FOREIGN SOCKET
SYSGT
MOVE A,B ;SAME CODE...
HRL A,X
GETAB
0
TRZ A,1 ;EVEN ONE OF PAIR
MOVEM A,FORNS ;FOREIGN SOCKET
MOVE A,['NETAWD'] ;HOST IS IN THIS TABLE
SYSGT
MOVE A,B
HRL A,X
GETAB
0
MOVEM A,NETAWD ;SAVE IT
HLRZ A,A ;GET HOST
ANDI A,777 ; ..
MOVEM A,FHSTN ; ..
JRST PSIINI
NOTNVT: MOVE A,LHOSTN ;ASSUME LOCAL HOST IF NOT AN NVT
MOVEM A,FHSTN ; ..
SETOM NETLSK ; HOPE I DON'T NEED SOCKET NUMBERS
SETOM FORNS ; ..
JRST PSIINI ;GO SET UP PSI SYSTEM
PSIINI: MOVSI A,^D3 ;ASSIGN ^C INTERRUPT
SKIPE DBUGSW ;OR ^E IF DEBUGGING
MOVSI A,^D5
HRRI A,CTCCHN ;TO THIS CHANNEL
ATI
MOVSI A,^D30 ;NVT DETACHING PSI CODE
HRRI A,DETCHN ;TO THIS CHANNEL
ATI
MOVEI A,400000 ;SET UP PSI SYSTEM
MOVE B,[LEVTAB,,CHNTAB] ; ..
SIR
MOVE B,ONCHNS ;TURN ON THESE CHANNELS
AIC
MOVEI A,400000 ;NOW TURN THE SYSTEM ON
EIR
MOVE A,['LHOSTN'] ;GET THE LOCAL HOST NUMBER
SYSGT
JUMPE B,HANGUP ;GOTTA HAVE ONE
MOVEM A,LHOSTN
HRROI A,LHSTNM ;PUT THE HOST NAME HERE
MOVE B,LHOSTN ;FROM THIS NUMBER
CVHST ;SEE IF WE KNOW WHO WE ARE
SKIPA ;NO, MAKE A PHONY NAME
JRST MAKTFK ;OK.
MOVE A,[ASCII /Site-/] ;FIRST PART OF NAME
MOVEM A,LHSTNM ; ..
HRROI A,LHSTNM+1
MOVE B,LHOSTN
MOVEI C,10 ;NUMBER IN OCTAL
NOUT
JFCL
MAKTFK: MOVSI A,(1B0!1B1) ;CREATE A FORK FOR TIMING
CFORK ; ..
JRST FULL ;IF TOO FULL, QUIT.
HRRZM A,TFORKX ;SAVE THE FORK INDEX
RPCAP ;MAKE SURE IT CAN POKE ME
TLO B,(1B9) ; ..
TLO C,(1B9) ; ..
EPCAP
MOVEI B,TFRKSA ;WHERE IT STARTS
SFORK ;START IT. IT WILL GIVE ME TIME CHECKS
;FALL THRU
;FALLS IN FROM ABOVE
GETPID:
IFN IPCLOG,<
MOVX A,IP%CPD ;GET A PID FOR SELF
MOVEM A,PIDARG
GPIDL: SETZM PIDARG+1 ;NO PID OF SENDER YET
GPID2: SETZM PIDARG+2 ;RECEIVER IS 0, IE INFO
MOVE A,[ENDMSG-INFMSG,,INFMSG]
MOVEM A,PIDARG+3 ;THE DATA OF THE MESSAGE TO INFO
MOVEI A,4 ;COUNT
MOVEI B,PIDARG ;DESCRIPTOR
MSEND ;GET PID OF FTSCTL
JRST [MOVEI A,^D1000
DISMS
JRST GPIDL]
MOVX B,IP%CPD ;DON'T CREATE ANOTHER
ANDCAM B,PIDARG
MOVE A,PIDARG+1 ;STASH MY NEW PID
MOVEM A,MYPID
GETAGN: SETZM PIDARG ;NO FLAGS
SETZM PIDARG+1 ;NO PARTICULAR SENDER
MOVE A,MYPID ;I AM RECEIVER
MOVEM A,PIDARG+2
MOVE A,[10,,IPCDAT] ;RECEIVE THIS MUCH DATA
MOVEM A,PIDARG+3
MOVEI A,4 ;LENGTH OF DESCRIPTOR
MOVEI B,PIDARG ;ADDR OF DESCRIPTOR
MRECV
JFCL
MOVE A,PIDARG ;GET FLAGS
ANDI A,7B32
CAIE A,1B32 ;SENT BY MONITOR?
CAIN A,2B32 ;SENT BY INFO?
SKIPA ;YES.
JRST GETAGN ;NO, NOT INTERESTED.
MOVE A,PIDARG
TRNE A,7 ;WAS THE PACKET UNDELIVERABLE?
JRST GPID2 ;YES.
TRNE A,77B29 ;TROUBLE?
JRST GETAGN ;YES.
MOVE A,IPCDAT+1 ;GET FTSCTL'S PID
MOVEM A,CTLPID ;SAVE IT.
>
SIGNON: HRROI A,[ASCIZ /300 /] ;REQUIRED HELLO MESSAGE
PSOUT
HRROI A,LHSTNM ;SITE NAME
PSOUT
HRROI A,[ASCIZ / FTP Service /]
PSOUT
LDB B,[POINT 9,VERSIO,11] ;GET MAJOR VERSION
MOVEI A,101 ;TYPE VERSION
MOVEI C,10 ;OCTAL NUMBERS
SKIPE B ;PRINT IF NON-ZERO
NOUT
JFCL
LDB B,[POINT 6,VERSIO,17] ;GET MINOR VERSION
JUMPE B,VERSI1 ;SKIP IF 0
SUBI B,1
IDIVI B,^D26 ;MAKE 2 LETTERS
JUMPE B,VERSI0 ;ANY FIRST LETTER?
HRRZI B,"A"-1(B) ;YES, PRINT
BOUT
VERSI0: HRRZI B,"A"(C) ;PRINT SECOND LETTER
BOUT
VERSI1: HRRZ B,VERSIO ;GET EDIT NUMBER
MOVEI C,10 ;OCTAL NUMBERS
JUMPE B,VERSI2 ;SKIP IF EDIT IS 0
MOVEI B,"(" ;PRINT OPEN PAREN
BOUT
HRRZ B,VERSIO ;GET EDIT NUMBER AGAIN
NOUT ;PRINT IT
JFCL
MOVEI B,")" ;PRINT CLOSE PAREN
BOUT
VERSI2: LDB B,[POINT 3,VERSIO,2] ;GET GROUP CODE
JUMPE B,VERSI3 ;SKIP IF ZERO
MOVEI B,"-" ;PRINT -
BOUT
LDB B,[POINT 3,VERSIO,2] ;GET GROUP CODE
NOUT
JFCL
VERSI3: repeat 0,< ;need directive to get this
HRROI B,[ASCIZ / %/]
MOVEI C,0
SOUT
MOVEI B,SRCVNO
MOVEI C,12
NOUT
JFCL
>
HRROI A,[ASCIZ / at /]
PSOUT
MOVEI A,101
SETO B,0 ;CURRENT TIME STAMP
MOVSI C,200221 ;FORMAT OF TIME
ODTIM
PUSHJ P,PCRLF ;END OF LINE
JRST GETCOM ;GO READ FIRST COMMAND
NOLINE: GJINF ;SEE IF I GOT DETACHED
JUMPL D,HANGUP ;IF SO, HANG UP AND LOG OUT
HRROI B,MSG500 ;NO, MUST BE SUPER LONG LINE
JRST RPCRLP ;GIVE FAILURE MSG AND READ AGAIN
MSG500: ASCIZ /500 Last line was not comprehensible./
SYNERR: JSP B,RPCRLP ;SYNTACTICAL ERROR IN COMMAND
ASCIZ /501 Syntax error at start of last command line./
SYNER2: JSP B,RPCRLP
ASCIZ /501 Syntax error - Character after command verb is bad./
ARGSYN: PUSHJ P,ADDREP ;HERE TO COMPLAIN OF ARGUMENT SYNTAX
ASCIZ /502 Syntax error in argument of /
MOVE C,KEYWRD ;NAME OF COMMAND
ARGSYL: MOVEI B,0 ;PRINT COMMAND
LSHC B,6 ;GET A SIXBIT CHARACTER
ADDI B,40 ;CONVERT TO ASCII FROM SIXBIT
IDPB B,A ;PUT IN REPLY BUFFER
JUMPN C,ARGSYL ;OUTPUT WHOLE WORD
MOVEM A,REPLYP ;CURRENT POINTER FOR REPLY
JSP B,RPCRLP ;CLOSE OFF MSG
ASCIZ / command./
FULL: HRROI B,[ASCIZ /401 Service full, please try later. Goodbye./]
JRST ERRRPL ;CAUSE HANGUP AFTER SENDING THIS
ABORPC: MOVE P,PDP ;RESTORE STACK LEVEL
HRROI B,[ASCIZ /? Unknown error interrupt
/]
SKIPE CTCFLG ;WAS IT A ^C?
HRROI B,[ASCIZ /Interrupt by user
/]
SKIPE IOXFLG ;I/O ERROR?
HRROI B,[ASCIZ +System I/O Error
+]
HRROI A,[ASCIZ /456 /]
PSOUT
JRST RETXX
BOMB: MOVE A,REPLYP
HRROI B,[ASCIZ /435 Fatal system error at /]
MOVEI C,0
SOUT
HRRZ B,0(P)
MOVEI C,10
NOUT
JFCL
MOVEM A,REPLYP
JSP B,ERRRPL
ASCIZ /. Please report it. Logging out./
;HERE TO GET A COMMAND LINE. FIRST SEE IF SYSTEM STILL UP
GETCOM: MOVE A,[440700,,REPLYM] ;INITIALIZE POINTER TO REPLY
MOVEM A,REPLYP ;FOR OTHER ROUTINES TO APPEND TO
MOVE P,PDP ;RESTORE STACK LEVEL, JUST IN CASE.
PUSHJ P,TIMEOK ;MARK THAT TIMEOUT HASN'T HAPPENED
TLNE F,L.CMDK ;ASKED TO KILL JOB BEFORE CMD READING?
JRST HANGUP ;YES, DO SO.
MOVE A,['ENTFLG'] ;SEE IF SYSTEM STILL OPEN
SYSGT
JUMPE B,GETCM1 ;IF NO SUCH TABLE,
JUMPN A,GETCM1 ;OR ENTFLG IS NON-ZERO, GO TO IT
SHUTDN: HRROI B,[ASCIZ /436 Service shutting down; goodbye./]
JRST ERRRPL ;HANG UP ON HIM
GETCM1: PUSHJ P,LINEIN ;COLLECT A COMMAND LINE FROM TTY
JRST NOLINE ;EOF OR SUPER-LONG LINE
MOVE A,['ENTFLG'] ;FLAG WENT OF DURING TYPEIN WAIT, MAYBE
SYSGT
JUMPE B,GETCM2 ;CONTINUE IF NO FLAG AVAIL
JUMPN A,GETCM2 ;OR FLAG STILL OK
JRST SHUTDN ;NO GOOD. HANG UP.
GETCM2: SKIPN CMDIB ;BLANK LINE?
JRST BLANK ;YES.
MOVE BP,[440700,,CMDIB] ;INITIALIZE SAVED BYTE POINTER
GETCM3: MOVEM BP,SBP ; ..
ILDB C,BP ;SKIP LEADING SPACES AND TABS
CAIE C,40 ;SST ROUTINE FAILS AT START OF LINE
CAIN C,11 ;SO DO IT THIS WAY
JRST GETCM3 ;THAT WAS A SPACE. SKIP IT.
CAIN C,";" ;LET'S ALLOW COMMENTS
JRST CMNTOK ; ..
PUSHJ P,SIN6BT ;COLLECT A SIXBIT WORD
JRST SYNERR ;DIDN'T START WITH A GOOD CHARACTER
LDB C,SBP ;GET THE BREAK CHARACTER
PUSHJ P,SST ;AND THEN STEP PAST ANY SPACES OR TABS
JUMPE A,SYNERR ;BAD IF FIRST CHAR ON LINE NOT ALPHANUM.
CAIE C,40 ;SPACING CHARACTER AFTER VERB?
CAIN C,11 ; ..
JRST PARS02 ;YES
JUMPN C,SYNER2 ;JUMP UNLESS END OF LINE
;FALL THRU
;FALLS THRU FROM ABOVE
PARS02: SKIPE C,KEYWRD ;ANY PREVIOUS KEYWORD?
MOVEM C,PRVKWD ;YES, SAVE IT.
MOVEM A,KEYWRD ;SAVE THE SIXBIT KEYWORD
MOVSI C,-NKEYS ;SEE IF WE CAN FIND THE KEYWORD
CAMN A,KEYS6B(C) ;THIS ONE?
JRST KEYFND ;YES
AOBJN C,.-2 ;NO, LOOK THRU LIST
NOTKEY: MOVE A,REPLYP ;NOT THERE. COMPLAIN
HRROI B,[ASCIZ /500 I never heard of the /]
MOVEI C,0
SOUT
MOVE C,KEYWRD
NOTKY1: MOVEI B,0
LSHC B,6 ;CONVERT NAME FROM SIXBIT
ADDI B,40 ; ..
IDPB B,A ;STORE IN REPLY
JUMPN C,NOTKY1 ;LOOP FOR ALL CHARACTERS
MOVEM A,REPLYP ;STORE POINTER SO FAR
HRROI B,[ASCIZ / command. Try HELP./]
JRST RPCRLP ;FINISH THE LINE
KEYFND: HRRZ B,KEYADR(C) ;DISPATCH TO ROUTINE
SKIPGE KEYADR(C) ;NEED TO BE LOGGED IN?
TLNE F,L.LOGI ;YES. AM I?
SKIPA ;LOGGED IN, OR DON'T NEED TO BE
JRST LGNPLS ;NO GOOD. COMPLAIN.
PUSHJ P,0(B) ;CALL IT
JRST RPCRLP
JRST RPCRLP
ERRRPL: TLO F,L.CMDK ;FLAG THIS WAS A FATAL ERROR
RPCRLP: MOVE A,REPLYP ;APPEND MSG IN B TO REPLY
MOVEI C,0 ;IT'S ASCIZ
HRLI B,440700 ;STRING POINTER (ALLOWS JSP B,RPCRLP)
SOUT
HRROI B,CRLFM ;APPEND CRLF
SOUT
HRROI A,REPLYM ;NOW SEND IT DOWN TELNET LINE
PSOUT
JRST GETCOM ;AND GET ANOTHER COMMAND
ADDREP: MOVE A,REPLYP ;ADD TEXT AFTER PUSHJ TO REPLY BUFFER
HRRO B,0(P) ;STRING PTR TO TEXT
MOVEI C,0 ;ASCIZ FORM
SOUT
MOVEM A,REPLYP ;UPDATE REPLY POINTER
HRRM B,0(P) ;POINTER TO WORD WITH NULL
AOS 0(P) ;ONE MORE IS WHERE TO RETURN TO
POPJ P,0 ;RETURN THERE.
CRLFRP: JSP B,RPCRLP ;JUST EOL, NO MORE TEXT
0 ;NO TEXT.
;COMMAND MACROS
C.LGN==1B18 ;NEED TO LOG IN TO USE THIS COMMAND
DEFINE KEYMAC < ;KEYWORDS
M1 (USER,0)
M1 (PASS,0)
M1 (ACCT,0)
M1 (HELP,0)
M1 (MAIL,0)
M1 (MLFL,0)
M1 (BYE,0)
M1 (ABOR,0)
M1 (NOOP,0)
M1 (NOP,0)
M1 (DEBUG,C.LGN)
M1 (CRASH,0)
M1 (BOMB,0)
M1 (BYTE,0)
M1 (SOCK,C.LGN)
M1 (TYPE,0)
M1 (STRU,0)
M1 (MODE,0)
M1 (RETR,C.LGN)
M1 (STOR,C.LGN)
M1 (APPE,C.LGN)
M1 (RNFR,C.LGN)
M1 (RNTO,C.LGN)
M1 (DELE,C.LGN)
M1 (LIST,C.LGN)
M1 (NLST,C.LGN)
M1 (ALLO,C.LGN)
M1 (REST,C.LGN)
M1 (STAT,C.LGN)
M1 (CWD,C.LGN)
M1 (XCWD,C.LGN)
>
DEFINE M1(A,B)< SIXBIT +A+>
KEYS6B: KEYMAC
NKEYS==.-KEYS6B ;LENGTH OF TABLE
DEFINE M1(A,B)< XWD B,Z'A>
;THE DISPATCH TABLE
KEYADR: KEYMAC
;COMMAND EXECUTION ROUTINES
ZUSER: GJINF ;SEE IF LOGGED IN ALREADY
JUMPN A,USER07 ;IF SO, COMPLAIN
TLZ F,L.ANON ;MAKE SURE NOT ANONYMOUS
SETZM $ACCT ;CLEAR ANY ACCOUNT JUNK
PUSHJ P,SST ;SKIP LEADING SPACES
MOVE A,[440700,,$USER] ;USER NAME STRING STORAGE
MOVEI C,^D39 ;MAXIMUM LENGTH
USER01: ILDB B,SBP ;GET A CHARACTER
IDPB B,A ;STORE IN STRING
JUMPE B,USER02 ;QUIT ON NULL
SOJG C,USER01 ;LOOP FOR WHOLE NAME
USERNG: SETZM USERNM ;TOO LONG. NO USER NUMBER.
AOS A,USRFCT ;COUNT BAD USER NAMES
CAIL A,5 ;ALLOW HIM A FEW, THEN FORCE HIM OUT
JRST USER03 ;TOO MANY
PUSHJ P,ADDREP ;TELL HIM USER DOESN'T EXIST
ASCIZ /431 No such user as /
HRROI B,$USER
SOUT
MOVEM A,REPLYP
JSP B,RPCRLP ;RETURN ERROR MSG
ASCIZ /./
USER03: JSP B,ERRRPL ;HANG UP WITH FOLLOWING MSG
ASCIZ /430 Too many login failures. Go away./
USER02: MOVX A,RC%EMO ;EXACT MATCH ONLY
MOVE B,[440700,,$USER] ;NAME STRING
RCUSR ;SEE IF USER EXISTS
ERJMP USERNG
TXNE A,<RC%NOM!RC%AMB> ;DOES IT EXIST
JRST USERNG ;NO SUCH USER
MOVEM C,USERNM ;OK. STORE THE NUMBER
CAMN C,ANODNO ;ANONYMOUS?
JRST USERAN ;YES. GO GET PASSWORD
USER04:
repeat 0,< ;until account logic goes in tops20
MOVE A,[440700,,$ACCT+1] ; BACK HERE FROM ANONYMOUS
MOVE B,USERNM ;SEE IF USER HAS A DEFAULT ACCOUNT
GDACC ; ..
JRST USER06 ;NO.
MOVEM A,$ACCT ;YES. STORE IT FOR LOGIN JSYS
>
USER06: HRROI B,[ASCIZ /330 Anonymous user ok, send real ident as password./]
TLNE F,L.ANON ;ANONYMOUS OR REAL USER?
JRST RPCRLP ;ANONYMOUS. ASK FOR NAME (SPCL MSG)
JSP B,RPCRLP ;REAL. ASK FOR PASSWORD
ASCIZ /330 User name ok. Password, please./
USER07: JSP B,RPCRLP ;ALREADY LOGGED IN ERROR
ASCIZ /504 You are already logged in./
USERAN: TLO F,L.ANON ;ANONYMOUS IS THE USER NAME
SETZM ANOPSW ;COLLECT ANONYMOUS PASSWORD
MOVSI A,100001 ;FROM SYSTEM FILE
HRROI B,[ASCIZ /PS:<SYSTEM>ANONYMOUS.USERFILE/]
GTJFN ; ..
JRST USERAN1 ;FILE NOT THERE
MOVEM A,LOGJFN ;STASH JFN HERE
MOVE B,[070000,,200000] ;READ ASCII FROM FIRST LINE
OPENF ;OPEN FILE
JRST USRAN2 ;CAN'T?
MOVE D,[440700,,ANOPSW] ;STORE TEXT HERE
MOVEI C,^D39 ;MAX LENGTH IN CASE FILE BAD
USRAN4: BIN ;GET A CHARACTER OF PASSWORD
CAIGE B,40 ;STILL GOOD?
JRST USRAN3 ;END
IDPB B,D ;STORE IN STRING
SOJG C,USRAN4 ;COUNT AND LOOP
USRAN3: MOVEI B,0 ;TERMINATE WITH NULL
IDPB B,D
USRAN2: CLOSE LOGJFN ;FINISHED WITH FILE
USRAN1: JRST USER04 ;GO BACK AND CHECK DEFAULT ACCT
ZPASS: SETZM $PASS ;MAKE SURE NO JUNK LEFT AROUND
SKIPN USERNM ;HAS A USER BEEN SEEN?
JRST PASS06 ;NO.
PUSHJ P,SST ;SKIP LEADING (UNQUOTED) SPACES
MOVE A,[440700,,$PASS] ;PASSWORD STRING STORAGE
MOVEI C,^D39 ;MAXIMUM LENGTH
PASS01: ILDB B,SBP ;GET A CHARACTER
CAIN B,"V"&37 ;QUOTE CHARACTER?
JRST PASS02 ;YES.
CAIL B,"A"+40 ;NOT QUOTED, MAKE LC BE UC
CAILE B,"Z"+40 ; ..
SKIPA ;NOT LOWER CASE
TRZ B,40 ;MAKE LOWER BE UPPER
PASS03: IDPB B,A ;STORE THE CHARACTER
JUMPE B,PASS04 ;JUMP AT END.
SOJG C,PASS01 ;SPACE COUNTER
PASSNG: SETZM $PASS ;CLEAR. FLAGS THAT NO GOOD PSWD YET.
AOS A,PASFCT ;COUNT BAD PASSWORDS
CAIL A,5 ;ALLOW A FEW, THEN FORCE OFF
JRST PASS05 ;TOO MANY.
JSP B,RPCRLP ;BAD, BUT NOT TOO MANY TIMES YET
ASCIZ /431 Password incorrect./
PASS05: JSP B,ERRRPL ;HANG UP ON HIM
ASCIZ /430 Password wrong again. Go away./
PASS02: ILDB B,SBP ;QUOTED CHARACTER. COPY IT.
JRST PASS03 ;WITHOUT CRUNCHING LOWER CASE TO UPPER
PASS04: TLNE F,L.LOGI ;AM I ALREADY LOGGED IN?
JRST PASCWD ;YES. IF CWD, DO ACCES.
SKIPN $PASS ;IF TRYING ANONYMOUS, PHONY PASSWORD
; STILL MUST BE NON-NULL.
JRST PASSNG ;FAIL. COUNT IT, REPLY, MAYBE HANGUP.
JRST PASS10 ;GO DO THE LOGIN.
PASSAC: JSP B,RPCRLP ;NO. ASK FOR THE ACCOUNT.
ASCIZ /331 Password OK, Account please./
PASS06: JSP B,RPCRLP ;PASS W/O USER
ASCIZ /431 User name before password, please./
;HERE WHEN READY TO TRY LOGGING IN
;BACK HERE FROM ACCT COMMAND, TOO, IF NOT YET LOGGED IN.
PASS10: MOVEI A,.SFNVT ;ARE LOGINS ON NVT'S ALLOWED?
TMON ; ..
JUMPE B,NVTNLI ;IF NOT, DON'T ALLOW FTP SERVICE EITHER
MOVE A,USERNM ;USER NUMBER
JUMPE A,PASS06 ;IF NO USER NAME YET, DON'T LOGIN.
repeat 0,< ;not yet supported by tops20
HRLI A,(1B16) ;BIT TO SUPPRESS LOGIN DATE UPDATE
>
MOVE B,[440700,,$PASS] ;PASSWORD
MOVE C,$ACCT ;AND ACCOUNT
TLNE F,L.ANON ;ANONYMOUS?
HRRI B,ANOPSW ;YES. HERE'S ITS PASSWORD.
LOGIN
JRST LGNFAL ;FAILED? STRANGE. GO REPORT IT.
TLO F,L.LOGI ;FLAG THAT I AM LOGGED IN.
PUSHJ P,CLRPSW ;CLEAR SECRET INFO
GJINF ;UPDATE JOB INFO
MOVEM A,GJINF1
MOVEM B,GJINF2
MOVEM C,GJINF3
MOVEM D,GJINF4 ; ..
MOVE A,REPLYP
MOVEI C,0
HRROI B,[ASCIZ /230 User /]
SOUT ;COMPOSE A PRETTY LOGIN MESSAGE
MOVE B,USERNM ;NAME STRING
DIRST
ERJMP .+1 ;CAN'T FAIL
HRROI B,[ASCIZ / logged in at /]
MOVEI C,0
SOUT
SETO B,0
MOVSI C,200221 ;FORMAT OF DATE/TIME
ODTIM
HRROI B,[ASCIZ /, job /]
MOVEI C,0
SOUT
HRRZ B,GJINF3 ;JOB NUMBER
MOVEI C,12
NOUT
0
MOVEM A,REPLYP ;MESSAGE POINTER SO FAR.
HRROI B,CRLFM ;END OF LINE
MOVEI C,0 ; ..
SOUT
HRROI A,REPLYM ;TYPE THE HERALD
PSOUT ; ..
HRROI A,IPCDAT ;AND TELL CONTROLLER
HRROI B,[ASCIZ /FTP SERVER: /]
MOVEI C,0
SOUT
MOVE B,[100700,,REPLYM] ;AFTER THE 230
SOUT
PUSHJ P,SNDCTL
JRST DOLOGIN ;GO GET THE FILE HANDLING PART OF CODE
LGNFAL: SKIPE $ACCT ;SEE IF DEFAULTING
JRST LGNFL1
CAIN A,LGINX1 ;DEFAULTING FAILED?
JRST PASSAC
CAIN A,VACCX0
JRST PASSAC
CAIN A,VACCX1
JRST PASSAC
CAIN A,VACCX2
JRST PASSAC
LGNFL1: PUSHJ P,CLRPSW ;CLEAR SECRET INFO
PUSH P,A
PUSHJ P,ADDREP ;BUILD A REPLY
ASCIZ /431 Login failed unexpectedly, /
POP P,B
HRLI B,400000 ;ERROR IN THIS FORK
ERSTR ;STRING FOR THE ERROR
JFCL
SKIPA
MOVEM A,REPLYP ;END OF STRING
JRST CRLFRP ;CARRIAGE RETURN AND REPLY
NVTNLI: JSP B,ERRRPL ;DON'T ALLOW THE LOGIN - DUE TO TMON
ASCIZ /453 Network logins not allowed at this time. Please try later./
.ORG ;HIGH SEGMENT
;HERE ON PASS COMMAND WHEN ALREADY LOGGED IN. SEE IF IT GOES WITH A CWD.
PASCWD: MOVE A,PRVKWD ;SEE WHAT PREVIOUS COMMAND KEYWORD WAS
CAME A,['CWD '] ;EITHER FORM OF CWD?
CAMN A,['XCWD '] ; ..
JRST PASCW1 ;YES
JSP B,RPCRLP ;NO. WHAT'S WITH THIS SILLY PASS?
ASCIZ /504 You are already logged in. I don't know what this password is for./
PASCW1: GJINF ;IT FOLLOWS CWD. SEE IF ALREADY
CAME B,$CWD ;CONNECTED TO THE DESIRED DIRECTORY.
JRST PASCW2 ;NO, GO DO IT.
JSP B,RPCRLP ;YES, IGNORE PASSWORD.
ASCIZ /200 Password not needed for this CWD./
PASCW2: MOVE A,$CWD ;DESIRED DIRECTORY
MOVEM A,$ACCES ;PUT IN ARGUMENT BLOCK
MOVE B,[440700,,$PASS] ;PASSWORD
MOVEM B,$ACCES+1 ;PUT IN ARGUMENT BLOCK
MOVEI A,3 ;THREE WORD ARGUMENT BLOCK
TXO A,AC%CON ;CONNECT TO DIRECTORY
MOVEI B,$ACCES ;GET ADDRESS OF ARGUMENT BLOCK
ACCES ;DO THE CONNECT
ERJMP PASCW3 ;FAILED
CWDOK: PUSHJ P,ADDREP
ASCIZ /200 Connected to /
MOVE B,$CWD ;PLUG NAME INTO MESSAGE
DIRST
MOVE A,REPLYP ;CAN'T FAIL HERE, I HOPE.
MOVEM A,REPLYP ;UPDATE POINTER
JSP B,RPCRLP ;OK
ASCIZ /./
PASCW3: JSP B,RPCRLP ;ACCES FAILED
ASCIZ /431 CWD-PASS: Directory or Password wrong./
.ORG ; BACK TO LOW SEGMENT
;ACCOUNT COMMAND
ZACCT: PUSHJ P,SST
MOVE A,SBP ;PICK UP ACCOUNT CHARACTERS HERE
MOVE B,[440700,,$ACCT+1];STORE STRING HERE
MOVEI D,^D39 ;MAX LENGTH OF STRING
SETZM $ACCT+1 ;CLEAR SO CAN TELL IF NULL ARGUMENT
ACCT01: ILDB C,A ;GET A CHARACTER OF THE ACCOUNT
JUMPE C,ACCT02 ;END OF ARGUMENT
CAIL C,"A"+40 ;LOWER CASE?
CAILE A,"Z"+40 ; ..
SKIPA ;NO
TRO C,40 ;YES, MAKE UPPER.
IDPB C,B ;ADD TO TEXT STRING
SOJG D,ACCT01 ;LOOP IF STILL SPACE.
ACCTNG: JSP B,RPCRLP ;STRING TOO LONG OR OTHERWISE BAD
ASCIZ /431 Account not valid./
ACCT02: SKIPN $ACCT+1 ;WAS STRING NON-NULL?
JRST ACCTNG ;NO. EMPTY STRING IS NG
MOVE T1,[440700,,$ACCT+1] ;HERE FOR STRING ACCOUNT
MOVEM T1,$ACCT ;THIS IS THE DESIGNATOR
MOVE B,T1 ;CHECK IT IN MONITOR
MOVE A,USERNM ;FOR THIS USER NUMBER
VACCT ;IS IT OK?
ERJMP ACCTNG ;NO
TLNN F,L.LOGI ;AM I LOGGED IN ALREADY?
JRST PASS10 ;NO, GO DO LOGIN.
MOVE A,$ACCT ;YES, CHANGE TO THIS ACCOUNT
MOVEI B,0 ;NO FLAGS
CACCT ;DO THE CHANGE
JRST ACCTNG ;THIS SHOULD NOT FAIL
JSP B,RPCRLP ;OK, ACCOUNT HAS BEEN CHANGED.
ASCIZ /200 Account OK./
;MORE COMMAND EXECUTION ROUTINES
ZTYPE: MOVEI P1,TYPTAB ;TABLE OF KNOWN TYPES
HRLI P1,-NTYPES ;NUMBER OF THEM
PUSHJ P,GETARG ;LOOK FOR ARG IN TABLE
JRST ARGSYN ;HAS TO BE ONE
JRST ARGUNK ;ARG WAS THERE BUT NOT KNOWN
HRRZ C,TYPTAB(B) ;DISPATCH FOR THIS ARG TO TYPE
JRST 0(C) ;GO TO IT
TYPEOK: MOVEM B,$TYPE ;SAVE THE INDEX INTO TABLE
PUSHJ P,ADDREP ;START BUILDING OK REPLY
ASCIZ /200 Type / ; ..
LCMRET: MOVE C,ARGWRD ;ADD THE ARG VALUE TO MSG
PUSHJ P,ADD6BC ;ADD SIXBIT IN AC C
JSP B,RPCRLP ;FINISH MSG AND RETURN
ASCIZ / ok./
;MACRO FOR DEFINING TABLES FOR ARGS TO TYPE, MODE, STRU COMMANDS
;FIRST TEXT ARG MUST BE THE DEFAULT. ITS VALUE IS 0
DEFINE KM(A,B)<
ZZ==0
IRP B,<
XWD <SIXBIT /B/>B53,A'$'B
A'.'B==ZZ
ZZ==ZZ+1
>;END IRP
>;END DEFINE
TY$A==<TY$I==<TY$L==<TY$XTP==TYPEOK>>>
TY$E==<TY$P==ARGNIM>
TYPTAB: KM (TY,<A,E,I,L,P,XTP>)
NTYPES==.-TYPTAB
ARGUNK: PUSHJ P,ADDREP ;AN ARGUMENT THAT ISN'T EVEN IN TABLE
ASCIZ /501 I never heard of /
MOVE C,KEYWRD
PUSHJ P,ADD6BC ;PUT COMMAND NAME IN
PUSHJ P,ADDREP
ASCIZ / with argument /
JRST ARGUN1
ARGNIM: PUSHJ P,ADDREP ;AN ARG IN THE TABLE BUT UNIMPLEMENTED
ASCIZ /506 /
MOVE C,KEYWRD ;COMMAND NAME
PUSHJ P,ADD6BC
PUSHJ P,ADDREP
ASCIZ / is not implemented for argument /
ARGUN1: MOVE C,ARGWRD
PUSHJ P,ADD6BC
JSP B,RPCRLP
ASCIZ /./
ADD6BC: MOVE A,REPLYP ;ADD SIXBIT WORD IN C TO REPLY
ADD6BL: MOVEI B,0
LSHC B,6 ;SHIFT IN A CHARACTER
ADDI B,40 ;SIXBIT TO ASCII
IDPB B,A ;INTO MSG
JUMPN C,ADD6BL ;LOOP IF MORE LETTERS
MOVEM A,REPLYP ;END OF REPLY SO FAR
IDPB C,A ;C IS NOW CLEAR. APPEND NULL.
POPJ P,0 ;RETURN FROM ADD6BC
GETARG: PUSHJ P,SIN6BT ;GET A WORD
POPJ P,0 ;SYNTAX ERROR
AOS 0(P) ;OK, SKIP AT LEAST ONE
MOVEM A,ARGWRD ;SAVE FOR ERROR MSGS, REPLIES
MOVEI B,0 ;INDEX INTO TABLE
GETAR2: HLLZ C,0(P1) ;GET UP TO 3 CHARACTERS
CAMN A,C ;SAME AS SUPPLIED ARG?
JRST GETAR1 ;YES.
ADDI B,1 ;NO, NEXT INDEX
AOBJN P1,GETAR2 ;LOOP LOOKING FOR IT
POPJ P,0 ;NOT IN TABLE
GETAR1: JRST CPOPJ1 ;SUCCESS. FOUND THE WORD.
ZMODE: MOVEI P1,MODTAB ;TABLE OF KNOWN MODES
HRLI P1,-NMODES ;NUMBER OF THEM
PUSHJ P,GETARG ;LOOK FOR ARG IN TABLE
JRST ARGSYN ;SYNTAX ERROR
JRST ARGUNK ;ARGUMENT NOT IN TABLE
HRRZ C,MODTAB(B) ;DISPATCH FOR THIS ARG
JRST 0(C) ;GO TO IT
MODEOK: MOVEM B,$MODE ;SAVE THE INDEX INTO TABLE
PUSHJ P,ADDREP ;START BUILDING OK REPLY
ASCIZ /200 Mode /
JRST LCMRET ;COMMON RETURN FOR GOOD LETTER COMMANDS
MODTAB: KM (MD,<S,B,T,H>)
NMODES==.-MODTAB
MD$S==MODEOK
MD$B==<MD$T==<MD$H==ARGNIM>>
ZBYTE: PUSHJ P,SST ;GET BYTE SIZE ARGUMENT
MOVE BP,SBP
PUSHJ P,DECIN1 ;COLLECT A NUMBER
JRST ARGSYN ;NOT A NUMBER
CAIE A,10 ;EIGHT BITS?
CAIN A,44 ;36 BITS?
JRST BYTEOK ;YES
CAIE A,40 ;32 BITS?
JRST BYTEX1 ;NO
BYTEOK: LDB B,BP ;GET TERMINATOR
JUMPN B,BYTEX1 ;SHOULD BE EOL
MOVEM A,$BYTE ;STORE THE VALUE
JSP B,RPCRLP ;OK
ASCIZ /200 Byte size accepted./
BYTEX1: JSP B,RPCRLP
ASCIZ /506 Byte size must be 8, 32, or 36./
ZSTRU: MOVEI P1,STRTAB ;ARGS TO STRUCTURE
HRLI P1,-NSTRUS ;NUMBER OF THEM
PUSHJ P,GETARG ;LOOK FOR ARG N TABLE
JRST ARGSYN ;SYNTAX ERROR
JRST ARGUNK ;NOT IN TABLE
HRRZ C,STRTAB(B) ;DISPATCH ADDRESS FOR THIS ARG
JRST 0(C) ;GO TO IT.
STRUOK: MOVEM B,$STRU ;STORE THE ARG
PUSHJ P,ADDREP ;BUILD A SUCCESS REPLY
ASCIZ /200 Structure /
JRST LCMRET ;FINISH IT UP
STRTAB: KM (ST,<F,R>)
NSTRUS==.-STRTAB
ST$F==STRUOK
ST$R==ARGNIM
;MORE COMMAND EXECUTION ROUTINES
LGNPLS: JSP B,RPCRLP
ASCIZ /451 Please log in first, with USER, PASS and ACCT./
ZNOP:
ZNOOP: JSP B,RPCRLP
ASCIZ /200 No-operation OK./
ZBYE: JSP B,ERRRPL ;SEND THIS MESSAGE, THEN HANG UP.
ASCIZ /231 BYE command received. Goodbye./
ZHELP: JSP B,RPCRLP
ASCIZ /100 The following commands are allowed before logging in:
100 USER, PASS, ACCT, NOP, NOOP, HELP, MAIL, MLFL, BYE,
100 BYTE (8 only), TYPE (A only), MODE (S only), and STRU (F only).
100 After logging in, the following are also allowed:
100 BYTE (8, 32 and 36 only), SOCK, TYPE (A,I,L,XTP only),
100 RETR, STOR, APPE, RNFR, RNTO, DELE, LIST, NLST,
100 STAT (for directory listing), CWD and XCWD.
200 End of help text./
BLANK: JSP B,RPCRLP ;BLANK LINE
ASCIZ /200 Blank line ignored./
CMNTOK: JSP B,RPCRLP ;LINE STARTED WITH SEMICOLON
ASCIZ /200 Comment OK./
ZCRASH: JRST 4,. ;TEST COMMAND FOR FATAL ERRORS
NOTIMP: PUSHJ P,ADDREP
ASCIZ /506 The /
MOVE C,KEYWRD ;PUT VERB INTO MESSAGE
NOTIM1: MOVEI B,0
LSHC B,6
ADDI B,40
IDPB B,A
JUMPN C,NOTIM1
MOVEM A,REPLYP
HRROI B,[ASCIZ / command is not yet implemented./]
POPJ P,0
ZBOMB: PUSHJ P,BOMB ;ANOTHER ONE
.ORG ;SWITCH TO HIGH SEGMENT
ZDEBUG: MOVEI A,400000 ;SEE IF I AM A WHEEL
RPCAP
TRNN B,600000 ; ..
JRST NOTIMP ;NO. PRETEND NOT IMPLEMENTED
DEBUG1: SKIPE 770000 ;YES. IS DDT THERE?
JRST DEBUG0 ;YES, GO TO IT.
MOVSI A,1 ;NO, GET IT
HRROI B,[ASCIZ /SYS:UDDT.EXE/]
GTJFN
JRST NOTIMP
HRLI A,400000 ;INTO THIS FORK
GET
MOVE A,116 ;JOBSYM
MOVEM A,@770001 ;TO $I-1
DEBUG0: MOVSI A,400000 ;NOW PUT ON COPY/WRITE BIT IN ACCESS
HRRI A,400 ;SO DDT CAN DO BREAKPOINTS
DEBUGL: RPACS ;SEE IF PAGE THERE
TLNN B,(1B5) ; ..
JRST DEBUGN ;NO
TLNE B,(1B10) ;IF SHARED, PUT ON CW
SKIPA B,[1B2!1B3!1B4] ;NO, PRIVATE. R,W,E
MOVSI B,(1B2!1B4!1B9) ;YES, MAKE IT R,E,CW
SPACS ; ..
DEBUGN: ADDI A,1 ;NEXT PAGE
HRRI B,(A)
CAIGE B,700 ;CONTINUE UP TO DDT
JRST DEBUGL ; ..
PUSHJ P,770000 ;CALL DDT
JSP B,RPCRLP
ASCIZ /200 End of debug./
ZREST: JSP B,RPCRLP ;RESTART COMMAND NOT IMPLEMENTED
ASCIZ /200 Restart command received but ignored./
.ORG ;SWITCH BACK TO LOW SEGMENT
HANGUP: movei a,101 ;wait for end of output
dobe ; ..
GJINF ;GET LATEST TTY NUMBER
DTACH ;GET OFF THE TTY
JUMPL D,NOclsD ;NOT IF DETACHED
hrroi a,gtjstr ;this sequence closes the nvt
hrroi b,[asciz /tty/]
movei c,0
sout ;build a string for the tty name
movei b,(d)
movei c,10 ;octal tty number
nout
jfcl
hrroi b,[asciz /:/]
movei c,0
sout
movsi a,1 ;now get a jfn for the tty
hrroi b,gtjstr
gtjfn
jrst noclsd ;shouldn't fail
push p,a ;save the jfn
movei a,.fhslf ;adjust my capabilities
rpcap
push p,c
push p,b
trz c,-1
epcap
move a,-2(p) ;now open the tty
move b,[070000,,100000]
openf
jfcl ;shouldn't fail
pop p,b ;restore capabilities
pop p,c ; ..
movei a,.fhslf
epcap
pop p,a ;get tty jfn again
closf ;this will close the net conn
jfcl ;shouldn't fail
NOclsD: SETO A,0 ;NOW LOG OUT
PUSHJ P,LOGOUT ;LOGOUT OR HALTF IF DEBUGGING
WAIT ;SHOULDN'T GET HERE...
JRST GO
LOGOUT: SETO A,0 ;LOGOUT ME
SKIPN DBUGSW
LGOUT
JFCL
SKIPE DBUGSW
HALTF
POPJ P,0
FORCLO: HRROI A,[ASCIZ /434 Autologout; Time exceeded without login.
/]
PSOUT
JRST HANGUP
TFRKSA: MOVEI A,^D60000
DISMS
MOVEI A,-1 ;MY SUPERIOR
MOVEI B,1B<TIMCHN> ;CHANNEL TO POKE HIM ON
IIC ;DO SO
JRST TFRKSA ;AND RETURN
PCRLF: PUSH P,A
HRROI A,CRLFM
PSOUT
POP P,A
POPJ P,0
SDUMPA: MOVEI A,101
MOVEI C,0
SOUT
POPJ P,0
CRLFM: BYTE (7)15,12,0
;HERE TO GET IN THE FILE ACTIVITY PORTION NOW THAT PROGRAM IS
;SAFELY LOGGED IN. NOTE THAT THIS GREATLY REDUCES SECURITY ERRORS.
DOLOGI: GJINF ;FIND OUT FROM SYSTEM WHETHER I AM
SKIPN A ; REALLY LOGGED IN.
PUSHJ P,BOMB ;NOT LOGGED IN! QUIT AND HANG UP.
PUSHJ P,GETHI ;MAP THE HIGH SEGMENT BACK TO LIFE
JRST GETCOM ;NOW ON TO NEXT COMMAND.
GETHI: MOVEI A,400 ;FIRST PAGE OF CRITICAL CODE
PUSH P,A ;CURRENT PAGE NUMBER TO STACK
GETLP: MOVSI A,400000 ;IN THIS FORK,
HRR A,0(P) ;AT THIS PAGE,
RPACS ;SEE IF PAGE IS THERE
TLNN B,(1B5) ; ..
JRST GETLPN ;NO, SO CAN'T MAKE IT ACCESSIBLE
MOVSI B,(1B2!1B4) ;SET ACCESS TO READ EXECUTE (NO WRITE)
SPACS ; ..
GETLPN: AOS A,0(P) ;LOOK AT NEXT PAGE
CAIGE A,700 ;UNLESS UP TO DDT AREA
JRST GETLP
POP P,A ;DISCARD PAGE NUMBER
POPJ P,0 ;END OF GETHI
;MISC SUBRS
CLOSER: SKIPGE 0(A) ;ANYTHING THERE?
POPJ P,0 ;NO SUCH JFN. RETURN.
PUSH P,A ;YES. SAVE A COUPLE AC'S
PUSH P,B
HRRZ A,0(A) ;GET JFN ITSELF
GTSTS
JUMPGE B,[RLJFN ;NOT OPEN. JUST RELEASE IT
CLOSF ; ..
JRST CLOSR1]
CLOSF
JFCL
CLOSR1: POP P,B ;RESTORE AC'S
POP P,A
SETOM 0(A) ;AND FLAG JFN GONE
POPJ P,0
CLOSEK: SKIPGE 0(A) ;CLOSE, KEEPING JFN. FILE THERE?
POPJ P,0 ;NO.
PUSH P,A ;YES, SAVE ADDR WHERE JFN IS
MOVE A,(A) ;GET THE JFN
HRLI A,(1B0) ;FLAG TO KEEP THE JFN
CLOSF ;CLOSE IT
JFCL
POP P,A ;RESTORE POINTER
POPJ P,0 ;RETURN
FRMHST: HRROI B,[ASCIZ / from host /]
MOVEI C,0 ;IDENTIFY THE HOST
SOUT
HRRZ B,FHSTN ;FOREIGN SITE NUMBER
MOVEI C,10 ;IN OCTAL IF NO NAME
CVHST ;NAME, IF ANY
NOUT ;NO, NUMBER.
JFCL
POPJ P,0
ORDERX: JSP B,RPCRLP
ASCIZ /504 Mail only accepted if you do NOT log in first./
CLRPSW: PUSH P,A ;BE TRANSPARENT
SETZM $PASS ;CLEAR SECRET INFO
MOVE A,[$PASS,,$PASS+1] ;IN ALL PASSWORD AREAS
BLT A,$PASS+7
SETZM ANOPSW
MOVE A,[ANOPSW,,ANOPSW+1]
BLT A,ANOPSW+7
SETZM CMDIB
MOVE A,[CMDIB,,CMDIB+1]
BLT A,CMDIB+20
JRST APOPJ
;THE LINE COLLECTOR. PERFORMS CHARACTER AND WORD AND LINE EDITTING.
;READS A LINE INTO CMDIN BUFFER, TERMINATED BY NULL, CRLF STRIPPED OFF.
LINEIN: PUSH P,P1
PUSH P,P2
PUSH P,P3
LINICU: ;REENTER HERE ON LINE DELETE
TLZ F,L.LTL!L.LICV ;CLEAR THIS ROUTINE'S FLAGS
MOVEI P1,<5*LCMDIB>-3 ;MAXIMUM LINE LENGTH TO READ
MOVE P2,LINEIP ;INITIAL BYTE POINTER TO BUFFER
SETZM CMDIB ;CLEAR THE BUFFER, TO BE NEAT
MOVE A,[CMDIB,,CMDIB+1] ; ..
BLT A,CMDIB+LCMDIB-1 ; ..
LININL: PUSHJ P,TELBIN ;BIN FROM NVT
JRST P3POPJ ;NON-SKIP IF TTY GETS EOF
TLZE F,L.LICV ;CONTROL V SEEN?
JRST LININ2 ;YES. STORE CHARACTER EXACTLY
CAIN B,12 ;IS IT A LINEFEED?
JRST LINEOL ;YES. QUIT.
CAIE B,0 ;NULL OR CARRET?
CAIN B,15 ; ..
JRST LININL ;YES, IGNORE COMPLETELY
CAIE B,"H"&37 ;EDITTING. BACKSPACE?
CAIN B,177 ;OR RUBOUT?
JRST LINICH ;YES
CAIN B,"W"&37 ;CONTROL W?
JRST LINICW ;YES
CAIN B,"U"&37 ;CONTROL U?
JRST LINICU ;YES.
CAIN B,"V"&37 ;SUPER-QUOTE?
TLO F,L.LICV ;FLAG CONTROL V SEEN, THEN STORE IT
LININ2: IDPB B,P2 ;STORE THIS CHARACTER
SOJG P1,LININL ;ACCUMULATE LINE
TLO F,L.LTL ;LINE TOO LONG
P3POPJ: POP P,P3 ;NON-SKIP RETURN
POP P,P2
POP P,P1
POPJ P,0
LINEOL: MOVEI B,0 ;NORMAL END OF LINE. TERMINATE WITH EOL
IDPB B,P2 ;TERMINATE THE STRING
AOS -3(P) ;SKIP RETURN
JRST P3POPJ ; ..
LINEIP: 010700,,CMDIB-1 ;INITIAL POINTER TO BUFFER
;EDITTING ROUTINES FOR LINEIN
LINICH: CAMN P2,LINEIP ;ALREADY AT START OF LINE?
JRST LININL ;YES, IGNORE THIS ^A
MOVEI B,0 ;CLOBBER THE CURRENT CHARACTER
DPB B,P2 ; ..
ADD P2,[070000,,0] ;BACK UP THE POINTER
SKIPGE P2 ;IF OFF END OF WORD,
SUB P2,[430000,,1] ;PREVIOUS WORD.
AOJA P1,LININL ;UN-COUNT THE DELETED CHARACTER
LINICW: LDB B,P2 ;GET CURRENT CHARACTER
PUSHJ P,ALNUMQ ;SKIP IF ALPHANUMERIC
JRST LINCW1 ;NO, A BREAK CHAR.
LINCW2: MOVEI B,0 ;THIS IS ALPHANUMERIC. CLOBBER IT.
DPB B,P2 ; ..
ADDI P1,1 ;UN-COUNT IT.
ADD P2,[070000,,0] ;BACK UP POINTER
SKIPGE P2
SUB P2,[430000,,1] ; ..
CAMN P2,LINEIP ;BACK TO START OF BUFFER?
JRST LININL ;YES. DONE DELETING
LDB B,P2 ;NO, SEE IF THIS IS STILL IN THE WORD.
PUSHJ P,ALNUMQ ;SKIP IF ALPHANUMERIC
JRST LININL ;BREAK. DONE.
JRST LINCW2 ;STILL IN WORD. GO DELETE IT.
LINCW1: MOVEI B,0 ;CURRENT CHAR IS A BREAK. GET BACK TO
DPB B,P2 ;WORD BEFORE BREAK(S), THEN DELETE IT.
ADDI P1,1 ;DELETE BREAK CHARACTER
ADD P2,[070000,,0]
SKIPGE P2
SUB P2,[430000,,1]
CAMN P2,LINEIP ;BACK TO START OF BUFFER?
JRST LININL ;YES. QUIT.
LDB B,P2 ;SEE IF MULTI-BREAKS AFTER LAST WORD
PUSHJ P,ALNUMQ ;ALPHANUMERIC?
JRST LINCW1 ;NO, MORE BREAKS. DELETE THIS ONE TOO
JRST LINCW2 ;INTO THE WORD. DELETE THE WORD.
ALNUMQ: CAIL B,"A"+40 ;LOWER CASE?
CAILE B,"Z"+40 ; ..
SKIPA ;NO.
JRST CPOPJ1 ;YES. SKIP RETURN.
CAIL B,"A" ;UPPER CASE?
CAILE B,"Z" ; ..
SKIPA ;NO
JRST CPOPJ1 ;YES. SKIP RETURN
CAIL B,"0" ;DIGIT?
CAILE B,"9" ; ..
SKIPA ;NO
JRST CPOPJ1 ;YES. SKIP RETURN.
CAIN B,"-" ;HYPHEN?
JRST CPOPJ1 ;YES. SKIP RETURN
POPJ P,0 ;SOMETHING ELSE. NON-SKIP.
SIN6BT: PUSH P,B ;ANSWER TO A, PRESERVE B AND C
PUSH P,C ; ..
MOVE BP,SBP ;CURRENT BYTE POINTER
MOVEI A,0 ;CLEAR THE ANSWER
MOVE C,[440600,,A] ;START POINTER TO ANSWER
SIN6BL: ILDB B,BP ;GET A CHARACTER
PUSHJ P,ALNUMQ ;A-Z, 0-9, OR HYPHEN?
JRST SIN6B1 ;NO, BREAK CHARACTER
CAIL B,100 ;YES. LETTER?
TRZ B,40 ;YES, MAKE SURE UPPER CASE.
SUBI B,40 ;YES. CONVERT TO SIXBIT
TLNE C,770000 ;ROOM FOR ANOTHER CHARACTER?
IDPB B,C ;YES, STORE IN KEYWORD
JRST SIN6BL ;ON TO THE BREAK
SIN6B1: MOVEM BP,SBP ;UPDATE STORED BYTE POINTER
POP P,C ;RESTORE AC'S
POP P,B ; ..
SKIPE A ;SKIP RETURN UNLESS NO WORD
AOS 0(P)
POPJ P,0
TELBIN: MOVEI A,100 ;BIN FROM PRIMARY INPUT
BIN ;CHARACTER TO AC B
TRZ B,200 ; clear junk bit
JUMPE B,TELBI0 ;NULL? DISCARD IF SO.
CAIN B,37 ;TTY EOL?
MOVEI B,12 ;YES, MAKE LINEFEED
CAIN B,15 ; also make CR into LF
MOVEI B,12
CPOPJ1: AOS 0(P) ;NO, OK. SKIP RETURN.
CPOPJ: POPJ P,0
TELBI0: MOVEI A,100 ;SEE IF EOF
GTSTS
TLNN B,1000
JRST TELBIN ;NO, DISCARD THE NULL.
POPJ P,0 ;YES. GIVE NON-SKIP RETURN. BUT
;PROBABLY DETACH WILL CAUSE PSI ANYHOW
TIMEOK: PUSH P,A ;UPDATE TIME TILL HANGUP FORCED
PUSH P,B ;SAVE AC'S
TIME ;GET SYSTEM UPTIME
IMULI B,WATTIM ;THIS MANY SECONDS TO WAIT
ADD A,B ;WAIT UNTIL TIME EQUALS THIS
MOVEM A,KTIMET ;THEN FORCE A LOGOUT.
BAPOPJ: POP P,B
APOPJ: POP P,A
POPJ P,0
SST: PUSH P,A ;SKIP SPACES AND/OR TABS AT CURRENT SBP
TLZ F,L.LICV ;FLAG FIRST CHARACTER
SSTL: LDB A,SBP ;GET THE CURRENT CHARACTER
CAIE A,40 ;IS IT A SPACE OR TAB?
CAIN A,11 ; ..
TLOA F,L.LICV ;YES. FLAG MOVING UP AT LEAST ONE CHAR.
JRST SST01 ;NO. QUIT HERE
IBP SBP ;IT'S A SPACE/TAB. MOVE PAST IT
JRST SSTL ;AND GO CHECK THE NEXT ONE.
SST01: MOVSI A,070000 ;BACK UP SO ILDB GETS THE NON-SPACE
TLZN F,L.LICV ;UNLESS DIDN'T MOVE FORWARD AT ALL.
JRST SST3 ;IN WHICH CASE LEAVE IT HERE.
ADD A,SBP ; ..
SKIPGE A
SUB A,[430000,,1]
MOVEM A,SBP
SST3: JRST APOPJ
;PSI HANDLERS
TIMINT: MOVEM 17,PI2AC+17 ;STASH THE AC'S
MOVEI 17,PI2AC ; ..
BLT 17,PI2AC+16
MOVE P,L2PDP ;AND SET UP A STACK
TIME
CAMG A,KTIMET ;TIME TO QUIT?
JRST L2DBRK ;NO.
TLNN F,L.ANON ;YES. ANONYMOUS USER?
TLNN F,L.LOGI!L.NALO ;OR NOT LOGGED IN AT ALL?
SKIPA ;YES. AUTOLOGOUT HIM.
JRST L2DBRK ;REAL LOGGED IN USER. LET IT SIT IDLE.
AOS A,LGOCNT ;COUNT THE FORCE-LEVEL COUNTER
CAIL A,2 ;PANIC?
JRST HANGUP ;YES. GET OUT
CAIL A,1 ;STILL NOT SEEN AT PROCESS LEVEL. FIRST?
JRST TIMIN1 ;NO, GO CAUSE DEBRK TO FORCE OFF
L2DBRK: MOVSI 17,PI2AC ;RESTORE AC'S
BLT 17,17 ; ..
DEBRK ;AND RETURN FROM LEV 2 PSI
TIMIN1: MOVEI A,FORCLO ;FORCED LOGOUT
HRLI A,(1B5) ;USER MODE
MOVEM A,RETPC2 ;BREAKING OUT OF PRESENT WORK
JRST L2DBRK
L1DBRK: MOVSI 17,PI1AC ;RESTORE LEV 1 AC'S
BLT 17,17 ; ..
DEBRK ;AND RETURN FROM LEV 1 PSI
DETINT: MOVEM 17,PI2AC+17 ;STASH AC'S
MOVEI 17,PI2AC ;JUST FOR SYMMETRY
BLT 17,PI2AC+16
MOVE P,L2PDP ;SET UP STACK
RESET ;KILL EVERYTHING. (SHOULD DELETE FILE?)
JRST HANGUP ;AND GO HANG UP NVT
CTCINT: MOVEM 17,PI2AC+17 ;STASH THE AC'S
MOVEI 17,PI2AC ; ..
BLT 17,PI2AC+16
MOVE P,L2PDP ;AND SET UP A STACK
SETOM CTCFLG
ABODBK: MOVEI A,ABORPC
HRLI A,(1B5) ;FORCE IT TO BREAK OUT AT THIS PC
MOVEM A,RETPC2
JRST L2DBRK
IOXINT: MOVEM 17,PI2AC+17 ;STASH THE AC'S
MOVEI 17,PI2AC ; ..
BLT 17,PI2AC+16
MOVE P,L2PDP ;AND SET UP A STACK
SETOM IOXFLG ;FLAG THE I/O ERROR
JRST ABODBK ;ABORT TO ABORPC ON DEBREAK
JRST L2DBRK
QTAINT: HRROI X,[ASCIZ/456 Exceeded working quota/]
MOVE P,PDP ;RESET STACK FOR COMMAND LEVEL
MOVEI A,RETXX ;DEBREAK OU TO CLOSE CONN ETC
MOVEM A,RETPC2
DEBRK
;THE FATAL (LEV 1) ONES
INSINT: MOVEM 17,PI1AC+17 ;STASH THE AC'S
MOVEI 17,PI1AC
BLT 17,PI1AC+16
MOVE P,L1PDP ;SET UP A STACK
JSP B,L1INTS
ASCIZ /Illegal Instruction trap/
MEMINT: MOVEM 17,PI1AC+17 ;STASH THE AC'S
MOVEI 17,PI1AC
BLT 17,PI1AC+16
MOVE P,L1PDP ;SET UP A STACK
JSP B,L1INTS
ASCIZ /Illegal memory reference trap/
PDLINT: MOVEM 17,PI1AC+17 ;STASH THE AC'S
MOVEI 17,PI1AC
BLT 17,PI1AC+16
MOVE P,L1PDP ;SET UP A STACK
JSP B,L1INTS
ASCIZ /Pushdown stack overflow trap/
FULINT: MOVEM 17,PI1AC+17 ;STASH THE AC'S
MOVEI 17,PI1AC
BLT 17,PI1AC+16
MOVE P,L1PDP ;SET UP A STACK
JSP B,L1INTS
ASCIZ /Disk or Drum overflow/
L1INTS: HRROI A,[ASCIZ /456 /]
PSOUT
HRROI A,(B)
PSOUT ;SPECIFIC FAILURE MESSAGE
HRROI A,[ASCIZ / at /]
PSOUT
MOVEI A,101 ;TYPE THE PC
HRRZ B,RETPC1
MOVEI C,10
NOUT
JFCL
HRROI A,[ASCIZ /. Goodbye.
/]
PSOUT
JRST HANGUP
;MAIL COMMAND - APPENDS MAIL TO MAIL.TXT.1 FOR LOCAL USER
;AND MLFL COMMAND, SAME BUT DATA ON DATA CONN INSTEAD OF TELNET.
ZMAIL: TLZA F,L.MLFL ;FLAG MAIL, NOT MLFL
ZMLFL: TLO F,L.MLFL ;FLAG MLFL, NOT MAIL
TLNE F,L.LOGI ;DON'T ACCEPT MAIL IF LOGGED IN.
JRST ORDERX ; ..
TLZ F,L.MFWD ;ASSUME NOT FORWARDING
CLOSE LCLJFN ;IN CASE ABORTED OUT OF MAIL
PUSHJ P,SST ;SKIP OVER TO NAME
SETOM LCLJFN
SETZM IBITCT ;NO BITS READ YET
SETZB A,MLUSR ;SEE IF ARG WINS. CLEAR DEST NAME
SETZM MLUNST ;PUT THE NAME IT WAS ADDRESSED TO HERE.
MOVE B,SBP
MOVEI C,5*17
MOVEI D,0
HRROI A,MLUNST
SOUT
MOVEI B,0
IDPB B,A ;TERMINATE STRING
SKIPN MLUNST ;THERE WAS A NAME, WASNT THERE?
JRST MAILX4 ;NO. A LOSING COMMAND
HRROI A,GTJSTR ;NOW MAKE THE DESTINATION NAME
HRROI B,[ASCIZ /PS:</] ;STICK IN USER NAME
MOVEI C,0
SOUT
HRROI B,MLUNST ;NAME FROM COMMAND
MOVEI C,0
SOUT ; ..
HRROI B,[ASCIZ />MAIL.TXT.1/]
MOVEI C,0
SOUT
;FALL THRU
;FALLS THRU
MOVSI A,101001 ;SEE IF MAILBOX EXISTS
HRROI B,GTJSTR
GTJFN
JRST MLFWQ ;IT DOESN'T. SEE IF FORWARDING EXISTS.
MOVE B,[XWD 1,1] ;MAKE SURE ALLEGED MAILBOX IS
MOVEI C,C ; PERMANENT. IF NOT, PRETEND
GTFDB ; IT DOESN'T EXIST
TLNN C,(1B1)
JRST [ RLJFN
JFCL
JRST MLFWQ]
RLJFN ;RELEASE MAILBOX JFN
JFCL
PUSHJ P,TIMEOK ;UPDATE KILL TIME
MOVX A,RC%EMO ;EXACT MATCH ONLY
HRROI B,MLUNST ;OK, GET DIRECTORY NUMBER
RCUSR ;SEE IF HE EXISTS
ERJMP MLX10 ;NO
TXNE A,<RC%NOM!RC%AMB> ;DOES IT EXIST
JRST MLX10 ;NO
MOVEM C,MLUSR ;SAVE THE DIRECTORY NUMBER
CAMN C,SYSDNM ;SYSTEM DIRECTORY?
JRST MAILX4 ;YES. REFUSE IT.
MAIL0A: HRROI A,GTJSTR ;BUILD A NAME FOR TEMP FILE FOR MAIL.
HRROI B,[ASCIZ /PS:<SYSTEM>--MAIL--./]
MOVEI C,0
SOUT
HRRZ B,GJINF3 ;JOB NUMBER
MOVEI C,12 ;DECIMAL
NOUT ;INTO FILENAME
JRST MLX10 ;IMPOSSIBLE FAILURE
HRROI B,[ASCIZ /;P770000;T/] ;AND MAKE JOB DEPENDENT.
MOVEI C,0
SOUT
MAIL01: MOVSI A,411001 ;GTJFN SHORT, STRING, OUT, TEMP, IG DEL.
HRROI B,GTJSTR ; ..
GTJFN
JSP A,MAILX9 ;CAN'T?
MOVEM A,LCLJFN ;STORE JFN
PUSHJ P,TIMEOK ;UPDATE KILL TIME
MOVE B,[070000,,100000] ;OPEN TO WRITE.
OPENF
JSP A,MAILX9 ;CAN'T?
HRROI B,[ASCIZ /Mail from /]
MOVEI C,0
SOUT
HRRZ B,FHSTN ;NOW PUT A TIME-STAMP ON. FIRST, HOST.
CVHST ;HOST NAME
JRST [HRROI B,[ASCIZ /site /]
SOUT
HRRZ B,FHSTN ;MAKE A NUMBER
MOVEI C,10
NOUT
JFCL
JRST .+1]
;FALL THRU
;FALLS THRU
MAIL1B: HRROI B,[ASCIZ / rcvd at /]
MOVEI C,0
SOUT
MOVSI C,(1B10+1B12+1B13+1B17)
SETO B,
ODTIM
HRROI B,CRLFM ;AND END LINE
MOVEI C,0
SOUT
TLNE F,L.MLFL ;MAIL FILE?
JRST MLFL01 ;YES. DIFFERENT DATA CAPTURE MECHANISM
HRROI B,[ASCIZ /350 Type mail, ended by a line with only a "."
/]
PUSHJ P,SDUMPA ;SEND MSG AND DUMP BUFFER
MAILL1: PUSHJ P,LINEIN ;NOW READ TELNET LINES.
JRST [TLNE F,L.LTL
JRST MAILX6
JRST MAILX8 ] ;EOF ON TELNET. ABORT.
MAIL1A: MOVE A,CMDIB ;SEE IF LINE WAS JUST A DOT
CAMN A,[ASCII /./] ; ..
JRST MAIL02 ;YES. DEFINES END.
MOVE A,LCLJFN
HRROI B,CMDIB ;PUT THE LINE IN THE TEMP FILE
MOVEI C,0
SOUT
HRROI B,CRLFM ;AND A CR LF WHICH WAS STRIPPED
SOUT
PUSHJ P,TIMEOK ;UPDATE KILL TIME
JRST MAILL1 ;LOOP TILL DOT OR EOF
MAIL02: MOVE A,LCLJFN ;NOW MOVE THE LOCAL FILE TO THE
HRLI A,(1B0) ;MAIL FILE. CLOSE THE WRITE.
CLOSF ;BUT KEEP THE JFN
JFCL
PUSHJ P,TIMEOK ;UPDATE KILL TIME
HRRZ A,LCLJFN ;RE-OPEN FOR READING
MOVE B,[070000,,200000] ; ..
OPENF
JSP A,MAILX9 ;CAN'T
RFPTR ;CHECK SIZE OF THE MAIL
JSP A,MAILX9 ;CAN'T FAIL
ASH B,3 ;EIGHT BITS PER
ADDM B,TRBITS
ASH B,-3
CAIL B,10000 ;DON'T ALLOW SUPER-HUGE FILES.
JRST MAILX5 ;BAD..
TLNE F,L.MFWD ;FORWARDING?
JRST [HRROI A,GTJSTR ;YES. COPY FILE NAME TO FWD THRU
HRROI B,MLFWST
MOVEI C,0
SOUT
JRST MAIL2A]
HRROI A,GTJSTR ;NOW MAKE THE DESTINATION NAME
HRROI B,[ASCIZ /PS:</] ;MUST BE ON PS:
SETZ C,
SOUT
MOVE B,MLUSR ;HIS DIRECTORY NUMBER
DIRST
JRST MLX10 ;SHOULDNT FAIL
HRROI B,[ASCIZ />MAIL.TXT.1/]
MOVEI C,0
SOUT
;FALLS THRU
;FALLEN INTO FROM ABOVE
MAIL2A: MOVEI X,5 ;TIMES TO TRY IF BUSY
MAIL2B: HRROI B,GTJSTR ;NOW GET A JFN FOR MAILBOX
MOVSI A,101001
TLNE F,L.MFWD ;FORWARDING?
TLZ A,101000 ;YES. ALLOW NEW FILE
MAIL2C: GTJFN
JRST MAILX4 ;NO SUCH FILE
PUSH P,A ;KEEP ON STACK
HRLI A,1 ;MAKE SURE IT'S UNDELETED
MOVSI B,040000
MOVSI C,0 ;NOT DELETED BIT
CHFDB
PUSHJ P,TIMEOK ;UPDATE KILL TIME
HRRZ A,0(P) ;RESTORE JFN
MOVE B,[070000,,020000] ;APPEND TO IT.
OPENF
JRST [MOVEM A,B ;SAVE ERROR CODE
POP P,A ;CAN'T
RLJFN
JFCL
SOJLE X,MLX15
MOVEI A,^D2000
DISMS
JRST MAIL2B]
MOVE A,LCLJFN ;GET # OF CHARS IN TEMP FILE
SIZEF
JRST [POP P,A
CLOSF
JFCL
JSP A,MAILX9]
MOVEM B,T1 ;SAVE # CHARS IN T1
TLNE F,L.MFWD ;FORWARDING?
JRST MAILL2 ;YES. DON'T PUT HEADER ON.
MOVE A,0(P) ;MESSAGE FILE
SETO B,0 ;PUT STANDARD MSG FILE FORMAT ON.
MOVSI C,(1B13) ;FIRST, DATE AND TIME WITH TIME ZONE.
ODTIM
MOVEI B,"," ;THEN COMMA
BOUT
MOVE B,T1 ;SIZE OF TEXT
MOVEI C,12 ;DECIMAL RADIX
NOUT
MOVE A,0(P)
;FALL THRU
;FALLS THRU
MOVEI B,";" ;NOW BIT FLAG FIELD
BOUT
SETZ B, ;IS NORMALLY 0.
MOVE C,FORNS ;IF FOREIGN ICP SOCKET
CAIL C,MLSKT ; IS AUTHENTICATED MAIL SOCKET
CAILE C,MLSKT+5 ; IN THIS GROUP OF 6
SKIPA ;NO GOOD.
TLO B,(1B7) ; OK, FLAG VERIFIED IN B7
MOVE C,[1B2+1B3+^D12B17+^D8] ;12 OCTAL DIGITS, LEADING 0'S.
NOUT
MOVE A,0(P)
HRROI B,CRLFM
MOVEI C,0
SOUT ;AND CR, LF ON END OF LINE
;FALL THRU
MAILL2: MOVE A,LCLJFN ;NOW PUT POINTER BACK AT START
MOVEI B,0 ; ..
SFPTR
JFCL
MOVE B,T1 ;COUNT 8-BIT CHARS, THOUGH INCLUDES
IMULI B,10 ; SMALL ERROR OF LOCAL HEADER
ADDM B,IBITCT
ADDM B,TRBITS
MLLUP1: PUSHJ P,TIMEOK ;LOOP TO COPY FROM TEMP TO MSG FILE
SKIPG C,T1 ;# OF CHARS LEFT TO COPY
JRST MAIL03 ;NO MORE
CAILE C,5000 ;IF > 1 PAGE, JUST DO PAGE
MOVEI C,5000
SUB T1,C ;ADJUST # REMAINING CHARS
MOVE A,LCLJFN ;SET UP TO READ FROM TEMP FILE
HRROI B,WINDOW ; INTO WINDOW
PUSH P,C ;SAVE # CHARS TO READ
MOVNS C ;MAKE COUNT NEGATIVE
MLLUP2: SIN ;READ
POP P,C ;# OF CHARS READ
MOVNS C ;WRITE THEM TO MSG FILE
HRROI B,WINDOW
MOVE A,0(P)
SOUT
JRST MLLUP1 ;LOOP FOR MORE
MAIL03: HRROI A,GTJSTR ; Where to build amusing string
HRROI B,[ASCIZ /Somebody at /]
SETZB C,D ; So we don't have to parse mail
SOUT
HRRZ B,FHSTN ; Foreign host number
CVHST ; Make a string
ERJMP [HRROI B,[ASCIZ /host number /]
SOUT ; Might as well type the number
HRRZ B,FHSTN ; Refetch the number
MOVEI C,^D8 ; Octal
NOUT
JFCL
JRST .+1] ; Rejoin main flow
POP P,A
HRLI A,.SFLWR ; Set last writer of MAIL.TXT
HRROI B,GTJSTR ; To string we just built
SFUST ; Do it
ERJMP .+1
MOVE A,1(P) ; Get JFN all over again
CLOSF
JFCL
; PUSHJ P,MLSTAT ;RECORD MAIL STATISTICS
TLO F,L.NALO ;NO AUTOLOGOUT, NOW. MAY BE MAILER.
HRROI X,MAILM2 ;MAIL DONE.
TLNE F,L.MLFL ;OR WAS IT MLFL
HRROI X,MAILM3 ;YES.
JRST MAIL05
MAILM3: ASCIZ /252 Mail completed successfully./
MAILM2: ASCIZ /256 Mail completed successfully./
;RECORD MAIL STATISTICS IF APPROPRIATE
MLSTAT: SKIPE DBUGSW ;RETURN IF DEBUGGING
POPJ P,0
MOVEI A,0 ;SEE IF MAIL2 DIRECTORY EXISTS
HRROI B,[ASCIZ /PS:<MAIL2>/]
RCDIR ; ..
ERJMP .+2 ;SYNTAX ERROR?
TXNE A,<RC%NOM!RC%AMB> ;DOES IT EXIST
JRST [TDZ C,C ;NO IT DOES NOT EXIST
JRST .+2]
SETO C,0 ;IT DOES
PUSH P,C ;REMEMBER IT
SETO B, ;CALCULATE VERSION NUMBER FOR
MOVSI D,(1B0+1B2+0B17) ; STATISTICS FILE BASED ON GMT DATE
ODCNV
MOVE A,C ;SAVE DAY OF WEEK IN RH, AND
HRL A,D ;GMT SECONDS SINCE MIDNIGHT IN LH
MOVEM A,MLTIMT ; IN A TIME TEMP CELL
HRRZ A,B ;MONTH
AOS A
IMULI A,^D100
HLRZ B,B ;YEAR
IDIVI B,^D100
ADD A,C ;VERSION=MMYY
TLO A,(1B17) ;SHORT FORM GTJFN
HRROI B,[ASCIZ /PS:<SYSTEM>MAIL.BLOG/]
SKIPGE 0(P) ;DOES MAIL2 EXIST?
HRROI B,[ASCIZ /PS:<MAIL2>MAIL.BLOG/] ;YES. USE IT
POP P,(P) ;DISCARD THAT FLAG
GTJFN
POPJ P,0 ;CAN'T, GIVE UP
MOVEM A,LOGJFN ;SAVE JFN
MOVE B,[1B19+1B20+1B25] ;READ,WRITE,THAWED
OPENF
JRST MLSTA2 ;CAN'T, GIVE UP
HRL A,LOGJFN ;MAP PAGE 1 OF STATISTICS FILE
HRRI A,1
MOVE B,[400000,,<WINDOW/1000>]
MOVSI C,140000 ;READ/WRITE
PMAP
MOVE A,FHSTN ;INCREMENT # OF MSGS RECEIVED
AOS WINDOW(A) ;FROM THIS HOST
SETO A, ;UNMAP PAGE
MOVEI C,0 ;NO COUNT
PMAP
HRL A,LOGJFN ;MAP PAGE 3 OF FILE
HRRI A,3
PMAP
MOVE A,LCLJFN ;GET # OF CHARS IN MESSAGE
SIZEF ;=LENGTH OF LOCAL FILE
SETZ B, ;SHOULDN'T FAIL
PUSH P,B ;SAVE THE SIZE
MOVE A,FHSTN ;ADD TO # OF CHARS RECEIVED
ADDM B,WINDOW(A) ;FROM THIS HOST
SETO A, ;UNMAP PAGE
MOVE B,[400000,,<WINDOW/1000>]
MOVEI C,0 ;NO COUNT
PMAP
;FALL THRU
;FALLS THRU
HRL A,LOGJFN ;MAP PAGE 4 OF FILE
HRRI A,4
MOVSI C,140000 ;READ/WRITE
PMAP
HRRZ C,MLUSR ;NUMBER OF USER RECEIVING MAIL
IDIVI C,^D36 ;CALCULATE WORD AND BIT
MOVSI A,400000 ; CORRESPONDING TO USER #
MOVNS D
ROT A,(D)
IORM A,WINDOW+200(C) ;TURN ON BIT FOR THAT USER
SETO A, ;UNMAP PAGE
MOVEI C,0 ;NO COUNT
PMAP
MOVS A,LOGJFN ;NOW THE TIME-HISTOGRAM PAGES
HRRI A,10 ;PAGE 10 IS CHARS BY TIME OF DAY
MOVE B,[400000,,<WINDOW/1000>]
MOVSI C,140000 ;READ AND WRITE ACCESS
PMAP
HLRZ A,MLTIMT ;GET THE TIME WITHIN DAY
IDIVI A,^D<60*30> ;THE HALF-HOUR WITHIN THE DAY
HRRZ D,MLTIMT ;THE DAY IN THE WEEK (MONDAY = 0)
IMULI D,^D48 ;SKIP N DAYS OF HALF-HOURS
ADD D,A ;AND ADD IN TODAY'S HALF-HOURS
POP P,A ;GET BACK LENGTH OF MSG
ADDM A,WINDOW(D) ;RECORD IT
MOVS A,LOGJFN ;NOW COUNT MSGS BY TIME OF DAY
HRRI A,7 ;IN THIS PAGE
MOVE B,[400000,,<WINDOW/1000>]
MOVSI C,140000 ;READ AND WRITE ACCESS
PMAP
AOS WINDOW(D) ;COUNT A MSG
MOVEI A,400000 ;NOW GET RUN TIME OF THIS FORK
RUNTM
SUB A,IFRKTM ;SINCE STARTED
SUB A,MALCPU ;LESS ANY POSSIBLE PREVIOUS MSG
ADDM A,MALCPU ;UPDATE FOR THIS MSG
ADDM A,WINDOW+777 ;COUNT IT IN TOTAL, LAST WD THIS PG
SETO A, ;UNMAP PAGE
MOVE B,[400000,,<WINDOW/1000>]
MOVEI C,0 ;NO COUNT
PMAP
MLSTA2: CLOSE LOGJFN ;CLOSE STATISTICS FILE
POPJ P,0
MLFWQ: MOVSI A,100001 ;GET JFN OF FORWARDER
HRROI B,[ASCIZ /SYS:MAILBOX.EXE/]
GTJFN
JRST MFWDX1 ;NOT THERE.
PUSH P,A ;SAVE JFN
PUSHJ P,TIMEOK ;UPDATE KILL TIME
MOVSI A,(1B1) ;CREATE AN INFERIOR FORK
CFORK
JRST MFWDX2 ;CAN'T
MLFWQ5: PUSH P,A ;SAVE FORK HANDLE
HRL A,0(P) ;GET PROG INTO FORK
HRR A,-1(P) ;JFN
GET
HRLZ A,0(P) ;PAGE 0 OF INFERIOR
MOVSI B,400000 ;MAPPED FROM THIS FORK
HRRI B,BLTPAG ;TEMP PAGE
MOVSI C,140000 ;RD, WRT ACCESS
PMAP
MOVSI T1,-10 ;COPY NAME
MOVE A,MLUNST(T1) ;COMMANDED ADDRESSEE
MOVEM A,BLTADR+140(T1) ;TO INFERIOR
AOBJN T1,.-2
MOVE A,0(P) ;FORK HANDLE AGAIN
MOVEI B,[1]-1 ;SET AC1 TO 1 FOR LOCAL SITE
SFACS
MOVEI B,2
PUSHJ P,TIMEOK ;UPDATE KILL TIME
SFRKV ;START UP INFERIOR
WFORK
PUSHJ P,TIMEOK ;UPDATE KILL TIME
RFSTS ;SEE IF IT FINISHED OK
HLRZ A,A ; ..
CAIE A,2 ;HALTF?
JRST MFWDX3 ;NO
MOVE A,0(P) ;HANDLE AGAIN
MOVEI B,ACTACS ;ACCOUNT FORK AC BLK IS FREE HERE
RFACS ;GET ANSWER
SKIPG T1,ACTACS+1 ;SUCCESS ANSWER?
JRST MFWDX3 ;NO
MOVE A,[440700,,LHSTNM] ;PREVENT LOOPS.
MOVE B,[440700,,BLTADR+150] ; BY CHECKING FOR LOCAL HOST
MOVEI C,50
MLFWQ2: ILDB T1,A
ILDB T2,B
CAME T1,T2
JRST MLFWQ3
JUMPE T1,MLFWQ1 ;IF MATCHED THRU END, CHECK NAME
SOJG C,MLFWQ2 ;LOOK TIL END OR MISMATCH
JRST MFWDX3 ;WIERD FAILURE.
MLFWQ1: MOVE A,[440700,,MLUNST] ;SEE IF USER NAME MATCHES TOO
MOVE B,[440700,,BLTADR+140]
MOVEI C,50
MLFWQ4: ILDB T1,A
ILDB T2,B
CAME T1,T2
JRST MLFWQ3
JUMPE T1,MFWDX3
SOJG C,MLFWQ4
JRST MFWDX3
MLFWQ3: HRROI A,MLFWST ;COPY OVER FOR A NEW FILE
HRROI B,[ASCIZ /[--UNSENT-MAIL--]./]
MOVEI C,0 ;MAILER STANDARD NAME
SOUT
HRROI B,BLTADR+140
SOUT
MOVEI B,"V"&37
BOUT ;QUOTE THE AT-SIGN
MOVEI B,"@"
BOUT
HRROI B,BLTADR+150
SOUT
HRROI B,[ASCIZ /;P770000/]
SOUT
HRROI B,[ASCIZ /951 mail will be forwarded to /]
PUSHJ P,SDUMPA ;TELL USER
HRROI B,BLTADR+140
PUSHJ P,SDUMPA ;GIVE HIM ADDRESSEE
HRROI B,[ASCIZ / at /]
PUSHJ P,SDUMPA
HRROI B,BLTADR+150
PUSHJ P,SDUMPA
HRROI B,CRLFM ;END OF LINE
PUSHJ P,SDUMPA
TLO F,L.MFWD ;FLAG FOR LATER PROCESSING
POP P,A ;FORK HANDLE
KFORK
MOVE A,0(P) ;AND MAILBOX.EXE JFN
HRLI A,(1B0)
CLOSF
JFCL
POP P,A
RLJFN
JFCL
PUSHJ P,TIMEOK ;UPDATE KILL TIME
JRST MAIL0A ;NOW GET THE MAIL
MFWDX3: POP P,A ;FORK
KFORK
MOVE A,0(P)
HRLI A,(1B0)
CLOSF
JFCL
POP P,A ;JFN FOR MAILBOX.EXE
RLJFN
JFCL
MFWDX1: JRST MAILX4
MFWDX2: MOVEI A,^D2000 ;Failed get fork, wait 2 sec & try again
DISMS
MOVSI A,(1B1)
CFORK
SKIPA ;Failed again
JRST MLFWQ5 ;Got fork, go on.
POP P,A ;No fork. Release MAILBOX.EXE JFN
RLJFN
JFCL
JRST MAILX3
MLBUSY: TLNE F,L.MFWD ;ONLY POSSIBLE IF TO REAL MAILBOX
JRST MAILX7
MOVE A,FHSTN ;DON'T QUEUE IF FROM SAME HOST
CAMN A,LHOSTN ; TO AVOID CIRCULAR SENDING
JRST MAILX7
HRROI A,GTJSTR ;OK TO QUEUE. MAKE FILE NAME
HRROI B,[ASCIZ /[--UNSENT-MAIL--]./]
MOVEI C,0
SOUT
HRROI B,MLUNST
SOUT
MOVEI B,"V"&37
BOUT
HRROI B,[ASCIZ /@;P770000/]
SOUT
TLO F,L.MFWD
JRST MAIL2A
MAIL04: HRROI B,(X) ;REPLY TO CORRECT AC
CLOSE LCLJFN
CLOSE DATJFN
JRST RPCRLP ;BACK TO TOP LEVEL
MAILX3: JSP X,MAIL05
ASCIZ /453 No forks available; please try later./
MAILX4: JSP X,MAIL05
MAILM4: ASCIZ /450 No such mailbox at this site./
MAILX5: JSP X,MAIL05
MAILM5: ASCIZ /451 Message too long./
MAILX6: JSP X,MAIL05
MAILM6: ASCIZ /451 Line too long./
MAILX7: JSP X,MAIL05
MAILM7: ASCIZ /453 Mailbox busy./
MAILX8: JSP X,MAIL05
MAILM8: ASCIZ /453 Net connection closed./
MAILX9: movei b,(a)
movei a,101
movei c,10
nout
jfcl
JSP X,MAIL05
MAILM9: ASCIZ /453 Scratch file failure./
MLX10: JSP X,MAIL05
MLM10: ASCIZ /453 Impossible error./
MLX11: JSP X,MAIL05
MLM11: ASCIZ /453 Disk full./
MLX12: JSP X,MAIL05
MLM12: ASCIZ /453 Mailbox damaged./
MLX13: JSP X,MAIL05
MLM13: ASCIZ /453 Unexpected failure to open mailbox./
MLX14: JSP X,MAIL05
MLM14: ASCIZ /450 Append access to mailbox not allowed./
MLX15: CAIE B,OPNX1 ;diagnose OPENF failure on mailbox
CAIN B,OPNX9
JRST MLBUSY
CAIN B,OPNX6
JRST MLX14
CAIN B,OPNX10
JRST MLX11
CAIN B,OPNX16
JRST MLX12
JRST MLX13
MAIL05: SKIPGE A,LCLJFN
JRST MAIL5Z
MOVE A,LCLJFN ;CLOSE OUT THE TEMP FILE.
HRLI A,400000
CLOSF
JFCL
HRRZ A,LCLJFN
DELF
JFCL
MAIL5Z: JRST MAIL04
;Subr used by MLFL (and FORMERLY XLPTF) to open ascii data connection.
OPN8NC: SKIPG $STRU ;ARGUMENTS FOR SIMPLE ASCII XFER?
SKIPLE $MODE ; ..
RET ;PARAMS BAD
SKIPN A,$BYTE ;BYTE SIZE 8?
MOVEI A,10 ;OR UNSPECIFIED?
SKIPG $TYPE ;AND ASCII TYPE?
CAIE A,10 ; ..
RET ;NO.
AOS 0(P) ;AT LEAST ONE SKIP AFTER HERE
HRROI A,GTJSTR ;BUILD NAME FOR DATA CONNECTION
HRROI B,[ASCIZ /NET:2./]
MOVEI C,0
SOUT
HRRZ B,FHSTN ;FOREIGN HOST NUMBER
MOVEI C,10 ;OCTAL
NOUT
0
MOVEI B,"-"
BOUT
MOVE B,FORNS ;FOREIGN SOCKET OF TELNET CONN
TRO B,1 ;HIS SOCKET IS A SENDER
ADDI B,2 ;AND TWO ABOVE THE TELNET
NOUT
0
HRROI B,[ASCIZ /;T/] ;MINE IS JOB RELATIVE
SOUT
MOVSI A,1 ;NOW GET A JFN
HRROI B,GTJSTR ;FOR THIS CONNECTION
GTJFN
RET ;CAN'T?
MOVEM A,DATJFN ;OK
HRROI A,[ASCIZ /255 SOCK /] ;SOCKET REPLY
PSOUT
MOVEI A,101
MOVE B,GJINF3 ;MY JOB NUMBER
ADDI B,^D100000 ;CONSTRUCT SOCKET NUMBER
LSH B,^D15 ; ..
ADDI B,2 ; ..
MOVEI C,12 ;TELL HIM IN NET VIRTUAL RADIX (10.)
NOUT
0
HRROI A,CRLFM ;END LINE
PSOUT
MOVE A,DATJFN ;NOW TRY TO OPEN THE CONNECTION
MOVE B,[102400,,200000] ;TYPE OF CONNECTION TO OPEN
OPENF
RET ;CAN'T?
JRST CPOPJ1 ;OK.
MLFL01: CALL OPN8NC ;GET A DATA CONNECTION
JRST MLFLXP
JRST MFPDX1
HRROI B,[ASCIZ /250 Begin mail file transfer.
/]
PUSHJ P,SDUMPA ;SEND MSG AND DUMP BUFFER
MLFLL1: MOVE A,DATJFN ;GET THE MAIL
BIN
JUMPN B,MLFLN ;EOF OR NULL?
GTSTS ;YES. SEE WHICH.
TLNE B,1000 ; ..
JRST MLFLEF
JRST MLFLL1 ;NULL. THROW IT AWAY.
MLFLN: CAILE B,177 ;AND THROW AWAY TELNET CONTROLS
JRST MLFLL1 ; ..
MOVE A,LCLJFN ;OK, A REAL CHAR. PUT IN FILE
BOUT
PUSHJ P,TIMEOK ;UPDATE TIMEOUT
JRST MLFLL1 ;ONWARD.
MLFLEF: CLOSE DATJFN
JRST MAIL02 ;NOW COPY TO REAL MAILBOX.
MFPDX1:
MFPDX2: CLOSE DATJFN
CLOSE LCLJFN
JSP B,RPCRLP
ASCIZ /454 Unable to establish data connection./
MLFLXP: JSP B,RPCRLP ;FAIL BECAUSE PARAMETERS NO GOOD
ASCIZ /454 Mail file must be 8-bit, Ascii type, Stream mode, File structure./
;NUMERIC INPUT ROUTINE. DECIMAL UNLESS PRECEDED BY "O" OR "X".
DECIN1: ILDB C,BP ;SKIP SEPARATOR FIRST
DECIN: MOVEI A,0 ;COLLECT NUMBER HERE
PUSH P,BP ;SAVE ORIGINAL BYTE POINTER
DECINL: CAIL C,"0" ;DECIMAL DIGIT?
CAILE C,"9" ; ..
JRST DECINX ;NO.
IMULI A,12 ;YES, ACCUMULATE NUMBER
ADDI A,-"0"(C) ; ..
ILDB C,BP ;ON TO NEXT CHARACTER
JRST DECINL ;SEE IF BREAK OR DIGIT
DECINX: CAMN BP,0(P) ;HAS ANY DIGIT BEEN SEEN?
JRST RADIXQ ;NO, MAYBE IT'S A LEADING X OR O
AOS -1(P) ;SAW A DIGIT. SKIP RETURN
POP P,0(P) ;DISCARD ORIGINAL POINTER
POPJ P,0 ;AND SKIP RETURN
RADIXQ: CAIE C,"O" ;OCTAL PREFIX?
CAIN C,"O"+40 ;OR LOWER CASE "O"
JRST OCTIN ;YES. GO READ IT
CAIE C,"X" ;HEX INPUT?
CAIN C,"X"+40 ; ..
JRST HEXIN ;YES. GO COLLECT HEX NUMBER
POP P,(P) ;NO GOOD. DISCARD POINTER ON STACK
POPJ P,0 ;AND GIVE NON-SKIP RETURN
OCTIN: ILDB C,0(P) ;UPDATE START OF NUMBER, SKIP THE "O"
MOVE BP,0(P) ; ..
OCTINL: CAIL C,"0" ;OCTAL DIGIT?
CAILE C,"7" ; ..
JRST RADIXX ;NO. QUIT.
LSH A,3 ;YES. ACCUMULATE NUMBER
ADDI A,-"0"(C) ; ..
ILDB C,BP ;GET NEXT CHARACTER
JRST OCTINL ;SEE IF END OF NUMBER
SNDCTL:
IFN IPCLOG,< ;DON'T USE THIS FEATURE YET
PUSH P,A
PUSH P,B
PUSH P,C
SETZM PIDARG ;SEND DATA TO FTSCTL
MOVEI C,3 ;TRY THREE TIMES
SNDCT1: MOVE A,MYPID
MOVEM A,PIDARG+1
MOVE A,CTLPID
MOVEM A,PIDARG+2
MOVE A,[20,,IPCDAT] ;SHOULD PUT CORRECT LENGTH ON
MOVEM A,PIDARG+3
MOVEI A,4 ;LENGTH OF DESCRIPTOR
mOVEi B,PIDARG ;ADDR OF DESCRIPTOR
MSEND
JRST [ MOVEI A,^D1000
DISMS
SOJGE C,SNDCT1
JRST .+1]
POP P,C
POP P,B
POP P,A
>
POPJ P,0
HEXIN: ILDB C,0(P) ;SKIP THE "X". UPDATE START OF NUMBER
MOVE BP,0(P) ; ..
HEXINL: CAIL C,"A"+40 ;LOWER CASE LETTER?
CAILE C,"Z"+40 ; ..
SKIPA ;NO
TRZ C,40 ;YES. MAKE UPPER CASE
CAIL C,"A" ;NOW, IS IT A HEX DIGIT-LETTER?
CAILE C,"F" ; ..
SKIPA ;NO
SUBI C,"A"-"9"-1 ;YES. SQUUNCH DOWN TO DIGITS
CAIL C,"0" ;DIGIT (INCLUDING A-F)?
CAILE C,"0"+17 ; ..
JRST RADIXX ;NO
LSH A,4 ;YES. ACCUMULATE NUMBER
ADDI A,-"0"(C) ; ..
ILDB C,BP ;ON TO NEXT CHARACTER
JRST HEXINL ;CONTINUE TILL BREAK CHARACTER
RADIXX: CAME BP,0(P) ;ANY DIGITS SEEN AT ALL?
AOS -1(P) ;YES. SKIP RETURN
POP P,(P) ;DISCARD STARTING BYTE POINTER
POPJ P,0 ; ..
.ORG ; TO HIGH SEGMENT
ZCWD: ;CHANGE WORKING DIRECTORY
ZXCWD: PUSHJ P,SST ;DOWN TO THE ARGUMENT
MOVX A,RC%EMO ;EXACT MATCH ONLY
MOVE B,SBP ;POINTER TO ARGUMENT
RCDIR ;SEE IF IT EXISTS
ERJMP XCWD1 ;IF SYNTAX ERROR TELL HIM BAD DIR.
TXNE A,<RC%NOM!RC%AMB> ;DOES IT EXIST
JRST XCWD1 ;NO
MOVE B,C ;IT DOES. JUST DIRECTORY NUMBER
MOVEM B,$CWD ; SAVE IT IN CASE PASSWORD FOLLOWS
MOVEI A,400000 ;GET CURRENT CAPS
RPCAP
PUSH P,B ;SAVE THEM
PUSH P,C ; ..
SETO C, ;ENABLE FOR THE ACCES
EPCAP ; ..
MOVE A,$CWD ;SEE IF CAN DO A ACCES TO IT
MOVEM A,$ACCES ;PUT IN ARGUMENT BLOCK
MOVEI B,0 ;WITHOUT A PASSWORD
MOVEM B,$ACCES+1 ;PUT IN ARGUMENT BLOCK
MOVEI A,3 ;THREE WORD ARGUMENT BLOCK
TXO A,AC%CON ;CONNECT TO DIRECTORY
MOVEI B,$ACCES ;GET ADDRESS OF ARGUMENT BLOCK
ACCES ;DO THE CONNECT
ERJMP XCWD2 ;NO.
POP P,C ;YES, RESTORE CAPS
POP P,B
MOVEI A,400000
EPCAP ; ..
JRST CWDOK ;SEND SUCCESS MESSAGE
XCWD2: POP P,C ;ACCES FAILED.
POP P,B ; ..
MOVEI A,400000 ;RESTORE CAPS
EPCAP
JSP B,RPCRLP ;SAY JUST PREFIX ACCEPTED.
ASCIZ /200 Default name accepted. Send password to connect to it./
XCWD1: JSP B,RPCRLP
ASCIZ /431 No such directory - CWD./
;SOCK COMMAND
ZSOCK: SETOM $HOST ;DEFAULT HOST
PUSHJ P,DECIN1 ;DECIMAL NUMBER ARGUMENT
JRST SOCKX1 ;SYNTAX ERROR
CAIE C,"," ;HOST NUMBER?
JRST SOCK01 ;NO.
SKIPL A ;YES. RANGE CHECK IT.
CAIL A,400 ;LEGAL ARPANET HOST?
JRST SOCKX2 ;NO.
MOVEM A,$HOST ;YES. SAVE IT.
PUSHJ P,DECIN1 ;AND GET SOCKET NUMBER
JRST SOCKX1 ;HAS TO BE ONE. DEFAULT NOT ALLOWED.
SOCK01: CAIE C,0 ;END OF LINE NOW?
JRST SOCKX1 ;NO. ERROR.
TLNE A,740000 ;LEGAL NUMBER?
JRST SOCKX3 ;NO.
MOVEM A,$SOCK ;YES. SAVE IT.
HRROI B,SOCKM1 ;SUCCESS MESSAGE
JRST RPCRLP ;AND RETURN TO COMMAND LOOP
SOCKX1: HRROI B,SOCKM2 ;HERE IF EOL NOT AT RIGHT PLACE
JRST SOCKXX
SOCKX2: HRROI B,SOCKM3 ;HERE ON BAD HOST NUMBER
JRST SOCKXX
SOCKX3: HRROI B,SOCKM4 ;HERE ON BAD SOCKET NUMBER (OVER 2**32)
SOCKXX: SETOM $SOCK ;CLEAR TO DEFAULTS
SETOM $HOST ; ..
JRST RPCRLP ;REPLY
SOCKM1: ASCIZ /200 Socket command accepted./
SOCKM2: ASCIZ /501 Syntax error in SOCK command./
SOCKM3: ASCIZ /503 Host number out of range 0 - 255./
SOCKM4: ASCIZ /503 Socket number out of range./
;COMMANDS NOT YET FULLY IMPLEMENTED.
;ABOR
ZABOR: TLNE F,L.ACTV ;FILE ACTIVITY?
JRST DOABOR ;YES. ABORT IT
HRROI B,ABORM1
JRST RPCRLP
DOABOR: TLO F,L.ABOR ;CAUSE ABORT TO HAPPEN
HRROI B,ABORM2 ;AND SAY IT WILL
JRST RPCRLP ;BACK TO TOP.
ABORM1: ASCIZ /202 ABOR request ignored./
ABORM2: ASCIZ /200 Abort request noted./
;RETRIEVE COMMAND. FILE FROM SERVER TO USER
ZRETR: TRZ F,R.TYPX ;ASSUME NOT PAGED MODE
TLO F,L.SEND ;THIS IS A SEND CONNECTION OF DATA
SKIPG B,$BYTE ;ANY DECLARED BYTE SIZE?
MOVEI B,10 ;NO. SET IT TO DEFAULT EIGHT-BIT
MOVEM B,$BYTE ; ..
SKIPLE $MODE ;SEE IF DEFAULT STREAM MODE.
JRST RETX0 ;NO.
MOVE C,$TYPE ;SEE IF PAGED TYPE
CAIE C,TY.XTP ;IS IT PAGED?
JRST RETR01 ;NO, WILL FILTER LATER
CAIE B,44 ;36 BITS AND PAGED?
JRST RETX0 ;NO.
TRO F,R.TYPX ;IT IS PAGED MODE. REMEMBER IN FLAG.
RETR01: SKIPLE $STRU ;STRUCTURE MUST BE DEFAULT NON-RECORD
JRST RETX0
PUSHJ P,TIMEOK ;UPDATE TIMEOUT
SETZM TYXSCT ;CLEAR NET SEQUENCE COUNT FOR PAGE MODE
PUSHJ P,JBKINI ;INITILIZE GTJFN BLOCK
MOVSI A,100000 ;EXISTING FILE FOR READING
MOVEM A,JBLOCK ;NO DEFAULT VERSION
MOVEI A,JBLOCK ;ARGUMENT TO LONG GTJFN
MOVE B,SBP ;POINT TO FILENAME ARG
GTJFN ;OPEN THE LOCAL FILE
JRST RETX1
MOVEM A,LCLJFN ;SAVE IT
LDB C,B ;WAS TERMINATOR THE END OF LINE?
JUMPN C,RETX2 ;IF NOT, COMPLAIN
PUSHJ P,JFNTXT ;STASH FILE NAME IN TXT STORAGE
TLZ F,L.LDSK!L.RNIL ;CLEAR A COUPLE FLAGS
MOVE A,LCLJFN ;OK. SEE WHAT TYPE DEVICE IT IS ON
DVCHR
HLRZS B ;TYPE FIELD
ANDI B,777
CAIN B,15 ;IS IT THE NIL:?
JRST RETNIL ;SPECIAL HANDLING FOR NIL
CAIN B,0 ;DISK?
TLO F,L.LDSK ;LOCAL DISK FILE.
SKIPLE P1,$TYPE ;DEFAULT ASCII TYPE?
JRST RET03 ;NO.
MOVE B,[070000,,200000] ;YES. READ IN 7-BIT BYTES.
JRST RETOPN ;OPEN THE FILE
RET03: CAIE P1,TY.L ;LOCAL BYTE?
JRST RET04 ;NO.
MOVE B,$BYTE ;GET THE CONNECTION BYTE SIZE
ROT B,-6 ;TO BYTE FIELD FOR OPEN
HRRI B,200000 ;AND OPEN FOR READ
JRST RETOPN ;OPEN IT.
RETNIL: TLO F,L.RNIL ;FLAG TO PHONY UP A NIL
JRST RET02 ;BYPASS OPENING IT.
RET04: CAIN P1,TY.XTP ;PAGED TYPE?
JRST RETOP0 ;YES. CHECKING DONE.
CAIE P1,TY.I ;IMAGE TYPE?
JRST RETX4 ;NO. UNKNOWN TYPE. (IMPOSSIBLE)
MOVE D,$BYTE ;GET THE BYTE SIZE
CAIE D,44 ;ONLY SUPPORT IMAGE 36 BITS NOW.
TLNE F,L.LDSK ;EXCEPT OK ON DISK
SKIPA
JRST RETX4 ;SAY NOT SUPPORTED, IF NOT 36-BITS.
HRROI B,SLOWM1 ;BUT GIVE THE GUY A COMMENT
CAIE D,44 ;THAT IT WILL BE SLOW IF 8 OR 32
PUSHJ P,SDUMPA ;DUMP ON TELNET SEND
RETOP0: MOVE B,[440000,,200000] ;OK FOR OPEN.
JRST RETOPN
RETOPN: MOVE A,LCLJFN ;GET LOCAL JFN BACK
PUSH P,B ;SAVE OPEN FLAGS.
OPENF
JRST [POP P,B
TRON B,1B25 ;TRY IT THAWED
JRST RETOPN
JRST RETX2] ;ALREADY DID. FAIL.
POP P,B ;CLEAR STACK
PUSHJ P,GETFDB ;SET UP THE FDB COPY OF LOCAL FILE
RET02: PUSHJ P,PREDAT ;SET UP THE DATA CONNECTION
JRST RPCRLP ;CAN'T. RETURN REASON.
TRNN F,R.TYPX ;PAGED MODE?
JRST RET02B ;NO.
MOVE A,$BYTE ;YES. MUST BE DISK OR NIL AND 36 BITS
CAIE A,44 ; ..
JRST RETX0 ;NOT 36 BITS
TLNN F,L.RNIL!L.LDSK ;DISK OR NIL?
JRST RETXPX ;NO.
RET02B: MOVE A,REPLYP ;SEND STARTED MSG
HRROI B,[ASCIZ /250 Retrieve of /]
SKIPL D,$TYPE ;OR MORE SPECIFIC MESSAGE.
CAIN D,TY.A ;ASCII TYPE?
HRROI B,[ASCIZ /250 ASCII retrieve of /]
CAIN D,TY.I
HRROI B,[ASCIZ /250 IMAGE retrieve of /]
MOVEI C,0
SOUT
HRRZ B,LCLJFN ;FILE NAME
MOVE C,[211110,,040001] ;FORMAT BITS
JFNS
HRROI B,[ASCIZ / started.
/]
MOVEI C,0 ; ..
SOUT
HRROI A,REPLYM ;SEND IT
PSOUT
MOVE A,[440700,,REPLYM] ;AND PREPARE FOR NEXT ONE
MOVEM A,REPLYP
SETZM REPLYM ; ..
;FALL THRU
;FALLS THRU FROM ABOVE
RET2A: TLNE F,L.LDSK ;LOCAL FILE A DISK?
JRST RETDSK ;YES.
TLNE F,L.RNIL ;NIL FILE?
JRST RETNL1 ;YES.
RETL: MOVE A,LCLJFN ;GET SOME INPUT
BIN
JUMPN B,RETNN
GTSTS
TLNE B,1000
JRST RETEOF
MOVEI B,0
RETNN: MOVE A,DATJFN
BOUT
PUSHJ P,TIMEOK ;WASTEFUL, EVERY BYTE, BUT...
MOVE A,$BYTE ;CURRENT BYTE SIZE
ADDM A,TSBITS ;ADD TO TOTAL SENT BITS
JRST RETL
RETNL1: SETO A, ;FREE UP THE WINDOW PAGE
MOVE B,[400000,,<WINDOW/1000>]
MOVEI C,0 ;NO COUNT
PMAP
MOVE A,$BYTE ;GET THE BYTE SIZE
CAILE A,10 ;10 OR DEFAULT?
JRST RETNL2 ;NO, 32 OR 36.
MOVE A,[BYTE (8)377,0,377,0]
MOVEM A,WINDOW ;ALTERNATING BYTES
MOVE A,[WINDOW,,WINDOW+1]
BLT A,WINDOW+777 ;WHOLE PAGE OF THEM
JRST RETNL3
RETNL2: MOVSI D,-1000 ;SET UP A PAGE OF -1 AND 0
SETZ A,
SETCAB A,WINDOW(D) ; ..
AOBJN D,.-1 ;WHOLE PAGE
RETNL3: MOVE P1,$BYTE ;BYTE SIZE
CAIG P1,10 ;HANDLE DEFAULT
MOVEI P1,10
MOVEI P2,1000 ;NUMBER OF BYTES IN A PAGE
CAIN P1,10 ;UNLESS 4 PER WORD,
MOVEI P2,4000 ;THIS NUMBER PER PAGE
MOVE T1,[^D1000000] ;A MILLION BITS
IDIVI T1,(P1) ;IS THIS MANY BYTES
SKIPE T2 ;PARTIAL WORD?
ADDI T1,1 ;YES. (36 BITS)
MOVE BP,P1 ;NOW BUILD BYTE POINTER
ROT BP,-14
HRRI BP,WINDOW-1 ; ..
MOVEI P1,(T1) ;NUMBER OF BYTES
MOVEM P1,FDBBLK+12 ;SAVE LENGTH FOR EOF
RETNLL: MOVE A,DATJFN ;SEND CONNECTION
MOVE B,BP ;STARTING POINTER
MOVNI C,(P1) ;NUMBER OF BYTES LEFT IN MEGABIT
CAILE P1,(P2) ;THIS MAKE A MILLION?
MOVNI C,(P2) ;NO, SEND A WHOLE PAGE
MOVN T2,C ;PLUS THIS BUNCH OF WORDS
IMUL T2,$BYTE ;THIS MANY BITS
ADDM T2,TSBITS ;ADD TO TOTAL SENT BITS
ADD P1,C ;UPDATE HOW MANY TO GO
SOUT ;SEND THIS BUNCH
JUMPG P1,RETNLL ;IF MORE TO GO, SEND MORE.
;NO MORE IF FALL THRU. CLOSE FILE.
TRNN F,R.TYPX ;PAGED TYPE?
JRST RETEOF ;NO, JUST CLOSE.
MOVE A,[400100,,31] ;MAKE UP A PHONY FDB FOR THE NIL FILE
MOVEM A,FDBBLK ; ..
MOVSI A,(1B0) ;CALL IT A TEMP FILE
MOVEM A,FDBBLK+1
SETZM FDBBLK+2
MOVE A,[FDBBLK+2,,FDBBLK+3]
MOVE B,FDBBLK+12 ;PRESERVE LENGTH
BLT A,FDBBLK+30 ;CLEAR REST
MOVEM B,FDBBLK+12 ;RESTORE LENGTH
MOVSI A,(5B2) ;MAKE A PROTECTION
HRRI A,770000 ; ..
MOVEM A,FDBBLK+4 ; ..
MOVE A,$BYTE
LSH A,30 ;BYTE SIZE IN B6-B11
MOVEM A,FDBBLK+11 ; ..
PUSHJ P,RETPEF
JRST RETEOF ;END OF THE NIL FILE
RETEOF: MOVEI B,21 ;SEND PARTIAL BUFFER
SKIPL A,DATJFN
MTOPR ; ..
JSP X,RETXX ;TYPE FOLLOWING MSG, CLOSE JFN'S.
MESS99: ASCIZ /252 Transfer completed./
RETXPX: JSP X,RETXX
ASCIZ /457 Paged transfer requested, but not on DSK or NIL./
RETX0: HRROI X,RET506
JRST RETXX ;CLOSE UP AND RETURN
STO506:
RET506: ASCIZ /457 Parameter combination illegal or unimplemented./
RETX4: MOVEI X,RET506
JRST RETXX ;ERROR AND CLOSE.
RETX1:
RETX2: MOVEI X,RETLUZ ;ERROR MESSAGE
JRST RETXX
RETX3: MOVEI X,ACCESM ;ACCESS DENIED MESSAGE
RETXX: SETO A, ;UNMAP THE WINDOW PAGES
MOVE B,[400000,,<WINDOW/1000>]
MOVEI C,0 ;NO COUNT
PMAP
ADDI B,1
PMAP
HRRI B,<WINDW2/1000>
PMAP
ADDI B,1
PMAP
CLOSE LCLJFN ;CLOSE THESE FILES IF OPEN
CLOSE DATJFN ; ..
HRROI B,0(X)
JRST RPCRLP ;REPLY
RETLUZ: ASCIZ /450 File not found./
ACCESM: ASCIZ /451 You do not have access for that file operation./
;DISK RETRIEVE ROUTINE.
RETDSK: TRNE F,R.TYPX ;PAGED TRANSFER MODE?
JRST RETDPG ;YES.
LDB D,[POINT 6,FDBBLK+11,11] ;FILE BYTE SIZE
MOVEI C,44 ;FIND BYTES PER WORD
SKIPE D ;IN CASE OF JUNK
IDIVI C,(D) ; ..
MOVE A,FDBBLK+12 ;BYTES PER THIS FILE
IDIV A,C ;WORDS PER THIS FILE
SKIPE B ;PARTIAL WORD?
ADDI A,1 ;YES. COUNT IT.
MOVEM A,LWORDS ;WORDS IN THE LOCAL FILE, IF ALL SEQ
SETOM WINDPN ;SCAN TO SEE IF ANY HOLES
RETDL2: AOS A,WINDPN ;A PAGE TO CHECK
HRL A,LCLJFN ;IN THIS FILE
RPACS ;SEE IF ITS THERE
TLNE B,(1B5) ;EXIST?
JRST RETDL2 ;YES. LOOK ONWARD.
FFUFP ;SEE IF ANY PAGES ARE USED BEYOND HERE.
JRST RETD00 ;NO. SIMPLE SEQUENTIAL FILE.
MOVSI D,(1B1) ;YES. MAKE LENGTH BE INFINITE, USE
MOVEM D,LWORDS ; OTHER TEST FOR END.
RETD00: SETZM WINDPN ;PAGE NUMBER FOR FILE WINDOW
RETDL: MOVS A,LCLJFN ;LOCAL FILE
HRR A,WINDPN ;PAGE IN IT
MOVE B,LWORDS ;LOCAL WORDS IN FILE
LSH B,-11 ;PAGES IN FILE
CAMGE B,WINDPN ;PAST LAST PAGE?
JRST RETEOF ;YES, END OF FILE.
RPACS ;PAGE ACCESS BITS
TLNE B,(1B5) ;PAGE EXIST?
JRST RETD01 ;YES. SEND IT.
FFUFP ;SEE IF ANY MORE PAGES BEYOND.
JRST RETEOF ;NO. END OF FILE.
SETO A, ;YES. PRETEND THIS HOLE WAS A PAGE OF 0.
RETD01: MOVE B,[400000,,<WINDOW/1000>]
MOVSI C,(1B2) ;MAP IN THE PAGE
PMAP
RETD02: MOVE D,LWORDS ;LOCAL WORDS IN FILE
LSH D,-11 ;PAGES
MOVE C,LWORDS ;WHOLE WORDS AGAIN
ANDI C,777 ;PARTIAL PAGE
CAMLE D,WINDPN ;TO LAST PAGE YET?
MOVEI C,1000 ;NO. USE WHOLE PAGE
MOVNS C ;- NUMBER OF WORDS
MOVE A,LCLJFN ;FIND BYTE SIZE
RFBSZ ;DECIDED ON EARLIER
JFCL ;ERROR RETURN
CAIN B,7 ;FIVE PER WORD?
IMULI C,5
CAIN B,10 ;FOUR PER WORD?
IMULI C,4
ROT B,-14 ;BYTE SIZE FOR SOUT BYTE PTR
IOR B,[440000,,WINDOW] ;POINTER FOR SOUT
MOVE T1,$TYPE ;SEE IF IT IS IMAGE MODE
CAIN T1,TY.I ; ..
JRST RETIMG ; YES.
RETD03: MOVE A,DATJFN ;SINK FOR SOUT
MOVE T2,$BYTE ;BYTE SIZE
IMUL T2,C ;MINUS NUMBER OF BITS BEING SENT
MOVNS T2 ;PLUS THAT MANY
ADDM T2,TSBITS ;ADD TO TOTAL SENT BIT COUNT
SOUT
AOS WINDPN ;COUNT TO NEXT PAGE
PUSHJ P,TIMEOK ;UPDATE TIMER
JRST RETDL ;NEXT PAGE, IF ANY.
RETIMG: MOVE T2,$BYTE ;IS IT 36 BIT IMAGE?
CAIN T2,44
JRST RETD03 ;YES. TREAT SIMPLY.
PUSH P,C ;NO. HAVE TO SHUFFLE DATA AROUND
MOVSI A,-1000 ;COUNT THRU A PAGE OF DATA
MOVSI B,-10 ;EIGHT STATE COUNTER
MOVE C,[-2000,,WINDW2-1] ;DESTINATION
RETIM1: MOVE T1,WINDOW(A) ;GET 36 BITS
AOBJN C,.+1 ;DESTINATION UP BY 1
TRNN B,-1 ;EVERY 8 PASSES, COUNT ANOTHER OUTPUT WD
AOBJN C,.+1
LSHC T1,@IMISHT(B) ;SHIFT RIGHT INTO T2
DPB T1,IMIPT1(B) ;STORE THE LEFT PART
MOVEM T2,0(C) ;AND THE RIGHT PART INTO NEXT WORD
AOBJN B,.+2 ;STEP THE COUNT-TO-8 COUNTER
MOVSI B,-10 ;RESTART IT
AOBJN A,RETIM1 ;PROCESS WHOLE PAGE THIS WAY
POP P,C ;GET BACK NUMBER OF BYTES TO SEND
IMULI C,11 ;NINE EIGHTHS
ASH C,-3 ; ..
MOVE B,$BYTE ;GET THE BYTE SIZE
CAIG B,10 ;WORDS OR BYTES?
ASH C,2 ;BYTES. FOUR TIMES THAT.
LSH B,30 ;TO PLACE IT GOES IN BYTE PTR
IOR B,[440000,,WINDW2] ;POINTER TO TRANSLATED DATA
JRST RETD03 ;GO SEND IT FROM SECOND WINDOW
IMISHT: REPEAT 10,< XWD 0,-4*<.-IMISHT+1>>
IMIPT1: REPEAT 10,< POINT ^D<32-<4*<.-IMIPT1>>>,-1(C),31>
RETDPG: SETOM WINDPN ;START AT PAGE 0
RETDP1: AOS A,WINDPN ;PAGE TO CONSIDER
RETDP3: HRRZM A,PAGNO ;STORE FILE PAGE NUMBER FOR NET
HRL A,LCLJFN ;SEE IF PAGE IS THERE
RPACS ; ..
MOVEM B,ACCESS ;SAVE BITS FOR NET
TLNN B,(1B5) ;PAGE EXIST?
JRST RETDP2 ;NO
MOVE B,[400000,,<WINDOW/1000>]
MOVSI C,(1B2) ;YES. MAP IT IN FOR READING
PMAP ; ..
SETZM RECTYP ;DATA RECORD
MOVEI A,1000 ;LENGTH IS ONE PAGE
SKIPN WINDOW-1(A) ;OR LESS
SOJG A,.-1 ; ..
CAIGE A,2 ;MAKE SURE AT LEAST SOME DATA
MOVEI A,2 ;SO LOOPS WORK
MOVEM A,TYXNDW ;STORE IN HEADER, NUMBER DATA WDS
PUSHJ P,RETPP1 ;OUTPUT IT
PUSHJ P,TIMEOK ;UPDATE TIMEOUT TIMER
JRST RETDP1 ;ON TO NEXT PAGE
RETDP2: FFUFP ;THIS PAGE NONEX. ANY MORE?
JRST RETDP4 ;NO.
HRRZM A,WINDPN ;YES, HERE IT IS.
JRST RETDP3 ;GO SEND IT.
RETDP4: PUSHJ P,RETPEF ;OUTPUT THE FILE TRAILER
JRST RETEOF ;AND GO CLOSE OUT.
RETPEF: SETZM ACCESS ;END OF FILE. CLEAR THESE OUT.
SETZM PAGNO ; ..
MOVNI A,3 ;HEADER FOR EOF
MOVEM A,RECTYP ; ..
SETO A, ;RELEASE WINDOW
MOVE B,[400000,,<WINDOW/1000>]
MOVEI C,0 ;NO COUNT
PMAP
MOVSI A,FDBBLK ;PUT THE FDB IN IT
HRRI A,WINDOW
BLT A,WINDOW+24 ; ..
MOVEI A,25 ;NUMBER OF DATA WORDS IN FDB
MOVEM A,TYXNDW ;TO HEADER FOR NET
; FALL THRU TO RETPP1
; FALL THRU FROM ABOVE, ALSO CALL HERE.
RETPP1: AOS A,TYXSCT ;COUNT THE NET SEQ NUMBER
MOVEM A,SEQNO ;PUT IT IN NET HEADER AREA
SETZM CHKSUM ;INITIALIZE CHECKSUM
PUSHJ P,PGCKSM ;CHECKSUM HEADER AND PAGE
SETCAM A,CHKSUM ;STORE FOR SENDING
MOVE A,DATJFN ;SEND IT
MOVEI B,TYXHDN ;SEND LENGTH OF HEADER
BOUT
MOVNI C,TYXHDN ;SEND THE HEADER
MOVE B,[444400,,TYXHED]
SOUT
MOVN C,TYXNDW ;AND THE DATA AREA, THIS LONG.
MOVE B,[444400,,WINDOW]
SOUT
POPJ P,0
GETFDB: SETZM FDBBLK ;CLEAR IT IN CASE NOT DSK
MOVE A,[FDBBLK,,FDBBLK+1]
BLT A,FDBBKE ; ..
MOVE A,LCLJFN ;LOCAL FILE
MOVSI B,31 ;ALL OF FDB
MOVEI C,FDBBLK ;STORE IT HERE
TLNE F,L.LDSK ;IF DISK,
GTFDB ;GET THE INFO
POPJ P,0
PGCKSS: MOVN B,MLFWST ;LENGTH OF RECEIVED HEADER STASHED HERE.
HRLZ B,B ;MAKE AOBJN POINTER
HRRI B,MLFWST+1 ;TO REST OF HEADER
JRST PGCKS1 ;COUNT THAT AND ITS DATA
PGCKSM: MOVSI B,-TYXHDN ;LENGTH OF HEADER ON RETR
HRRI B,TYXHED ;LOCATION OF HEADER ON RETR
PGCKS1: MOVEI A,0
JCRY0 .+1
PGCKL1: ADD A,0(B) ;CHECKSUM THE HEADER
JCRY0 [AOJA A,.+1]
AOBJN B,PGCKL1
MOVN B,TYXNDW ;NUMBER OF DATA WORDS
HRLZS B ;AOBJN COUNTER
JCRY0 .+1
PGCKL2: ADD A,WINDOW(B)
JCRY0 [AOJA A,.+1]
AOBJN B,PGCKL2
AOJE A,CPOPJ
SOJA A,CPOPJ
;STORE AND APPEND COMMANDS. FILE FROM REMOTE TO SERVER.
ZSTOR: TLZA F,L.APPE ;NOT APPEND
ZAPPE: TLO F,L.APPE ;APPEND. MUCH LIKE STOR.
TLZ F,L.SEND ;NET CONN IS RECEIVER
TRZ F,R.TYPX ;ASSUME NOT PAGED MODE
SETZM TYXSCT ;BUT IF IT IS, START AT SEQ ZERO
SETZM RECTYP ;IN CASE EOF COMES IN IMMEDIATELY.
PUSHJ P,PREDAT ;SET UP COMMON PARAMS,
JRST RPCRLP ;NO GOOD. MSG IN B.
SETZM IBITCT ;IMAGE BIT COUNT IS 0
SKIPG A,$BYTE ;BYTE STILL AT DEFAULT?
MOVEI A,10 ;YES. SET TO REAL SIZE
MOVEM A,$BYTE ; ..
SKIPLE B,$MODE ;STREAM MODE?
JRST STOX0 ;NO. UNSUPPORTED.
MOVE B,$TYPE ;SEE IF PAGED TYPE
CAIE B,TY.XTP ; ..
JRST STO00 ; NO
CAIE A,44 ;AND 36 BIT BYTES?
JRST STOX0 ;NO. BAD.
TLNE F,L.APPE ;YES. STOR, I HOPE.
JRST STOX0 ;NO. CANT APPEND IN PAGE MODE
TRO F,R.TYPX ;OK. FLAG PAGE MODE IN AC F
STO00: SKIPLE $STRU ;ONLY FILE STRUCTURED SO FAR.
JRST STOX0
PUSHJ P,TIMEOK ;UPDATE TIMEOUT.
PUSHJ P,JBKINI ;SET UP THE DEFAULT STRINGS IN GTJFN BLK
MOVSI A,(1B0+1B13) ;OUTPUT USE BIT AND REQUEST BITS BIT
TLNE F,L.APPE ;UNLESS APPEND, WHENCE
MOVSI A,(1B13) ;USE CURRENT VERSION IF ANY.
TLNE F,L.ANON ;IF ANONYMOUS, NO NEW FILES AT ALL.
MOVSI A,(1B2+1B13) ;SO DON'T DEFAULT TO NEW VERSION
MOVEM A,JBLOCK ; ..
MOVEI A,JBLOCK ;ARG TO LONG GTJFN
MOVE B,SBP ;HIS TEXT STRING
GTJFN ;GET IT.
JRST STOX1 ;CAN'T
HRRZM A,LCLJFN ;STORE THE JFN
SKIPE JBLOCK+7 ;WAS THERE AN ACCOUNT?
JRST STO01 ;YES. MAIN STRING POINTER NOT NEEDED.
STO01: LDB C,B ;GET THE TERMINATOR
JUMPN C,STOX2 ;JUMP IF NOT EOL
MOVE A,LCLJFN ;OK. NAME WAS GOOD.
PUSHJ P,JFNTXT ;STORE THE TEXT STRING FOR FILE NAME
STO01A: MOVE A,LCLJFN
DVCHR ;SEE WHAT DEVICE IT'S ON.
TLNN B,777 ;DISK?
TLOA F,L.LDSK ;YES.
TLZ F,L.LDSK ;NO
HLRZ B,B ;CHECK FOR NIL TOO
ANDI B,777
CAIN B,15 ;NIL DEVICE?
TLOA F,L.RNIL ;YES
TLZ F,L.RNIL ;NO
TRZ F,R.RLPT ;ASSUME NOT TO SPOOLED LPT
CAIN B,7 ;LPT?
JRST STOLPT ;YES. GO SEE IF SPOOLED
SKIPLE P1,$TYPE ;TYPE PARAMETER.
JRST STO03 ;NOT ASCII
STOLP1: MOVSI B,(7B5) ;WRITE 7-BIT BYTES
JRST STOOPN ;OPEN THE FILE
STOLPT: TLNE F,L.ANON ;ANONYMOUS LOGIN?
JRST STOX8 ;YES. LET'S NOT HAVE ANONYMOUS LISTINGS
MOVE B,$BYTE ;FOR NOW, ONLY ALLOW ASCII 8-BIT.
; THIS SHOULD BE FIXED, THOUGH.
CAIN B,10 ;EIGHT BIT CONN?
SKIPLE P1,$TYPE ;AND ASCII?
JRST .+2 ;NO.
JRST STOLP1 ;YES. SIMPLE LOOP DOES IT.
STLPX1: JSP X,STOXX ;ERROR.
ASCIZ /503 TRANSFERS TO LPT MUST BE ASCII, 8-BIT CONNECTIONS./
STO03: CAIE P1,TY.L ;LOCAL BYTE MODE?
JRST STO04 ;NO.
MOVE B,$BYTE ;GET THE BYTE SIZE
ROT B,-6 ;TO RIGHT PLACE FOR OPENF
JRST STOOPN ;OPEN THE FILE
STO04: CAIN P1,TY.XTP ;PAGED MODE?
JRST STOOP0 ;YES. ALL CHECKED OUT
CAIE P1,TY.I ;IMAGE TYPE?
JRST STOX4 ;NO. UNIMPLEMENTED.
MOVE D,$BYTE ;BYTE SIZE
CAIE D,44 ;ONLY 36 BIT IMAGES EXIST FOR NOW.
TLNE F,L.LDSK!L.RNIL ;EXCEPT ALLOW IT ON DSK AND NIL
SKIPA
JRST STOX4
HRROI B,SLOWM1 ;BUT COMPLAIN ABOUT IT.
CAIE D,44 ;IF NOT 36 BIT MODE
PUSHJ P,SDUMPA ;SEND DOWN TELNET CONN
STOOP0: MOVSI B,(44B5) ;OK. OPEN TO WRITE IT THAT WAY
JRST STOOPN ; ..
STOOPN: HRRI B,100000 ;BIT FOR WRITING
TLNE F,L.APPE ; OR
HRRI B,020000 ;BIT FOR APPENDING
PUSH P,B ;HOLD THE OPEN BITS
STO02: POP P,B ;RESTORE OPENF SIZE AND DIRECTION
MOVE A,LCLJFN ;RESTORE THE JFN
OPENF ;OPEN ACCORDING TO STUFF IN B
JRST STOX2 ;CAN'T.
MOVE A,REPLYP ;OK. TELL USER WE ARE READY TO GO.
HRROI B,[ASCIZ /250 Store of /]
TLNE F,L.APPE ;OR APPEND MSG
HRROI B,[ASCIZ /250 Append to /]
MOVEI C,0
SOUT
HRRZ B,LCLJFN ;DISK FILE OR WHATEVER
MOVE C,[211111,,140001] ;BITS FOR FORMAT
JFNS
HRROI B,[ASCIZ / started.
/]
SKIPL D,$TYPE ;OR MORE SPECIFIC MESSAGE
CAIN D,TY.A ;ASCII?
HRROI B,[ASCIZ /, ASCII type, started.
/]
CAIN D,TY.I ;IMAGE?
HRROI B,[ASCIZ /, Image type, started.
/]
MOVEI C,0 ; ..
SOUT ;BUILD THE LINE
HRROI A,REPLYM ;SEND IT
PSOUT ;ON TTY
MOVE A,[440700,,REPLYM] ;PREPARE FOR NEXT REPLY AT COMPLETION
MOVEM A,REPLYP ; ..
SETZM REPLYM ; ..
;FALL THRU
;FALLS THRU FROM ABOVE
STO02A:
STOL: TRNE F,R.TYPX ;PAGED MODE?
JRST STOTYX ;YES.
MOVE A,DATJFN ;GET BYTE FROM NET DATA CONNECTION
MOVE B,$BYTE ;GET BYTE SIZE
MOVNI C,1000 ;ASSUME 36 BIT BYTE
CAIG B,10 ;OR 32 BIT. 8-BIT IS 4 PER WORD
MOVNI C,4400 ; ..
CAIN B,40 ;IF 32 BIT, GET MORE THAN A PAGE, SO
MOVNI C,1100 ;AN EVEN NUMBER OF 36 BIT WDS
LSH B,30 ;MAKE THE SIN POINTER
HRRI B,WINDOW-1 ; ..
PUSH P,B ;SAVE FOR LATER CONTEMPLATION
PUSH P,C ;AND THE CHAR COUNT TOO
SIN ;READ FROM THE NET DATA CONN
STONN: MOVE A,LCLJFN ;GET LOCAL FILE HANDLE
RFBSZ ;GET WRITING FILE SIZE
JFCL ;ERROR RETURN
CAME B,$BYTE ;SAME AS NET?
JUMPN B,STONSS ;NOT SAME SIZE (EXCEPT NIL, SIZE =0)
STON1: POP P,D ;ORIGINAL COUNT
POP P,B ;ORIGINAL POINTER
SUB C,D ;C GETS POS NUMBER WORDS TRANSFERRED
IMULI C,44 ;BITS
ADDM C,IBITCT ;COUNT THEM
ADDM C,TRBITS ;ADD TO TOTAL FOR THIS LOGIN
IDIVI C,44
MOVNS C ;NOW NEGATIVE
TLNN F,L.RNIL ;IF NOT NIL,
SOUT ;SEND THEM.
STOEFQ: MOVE A,DATJFN ;CHECK FOR END OF FILE
GTSTS ; ..
TLNE B,600000 ;ERRORS OR CLOSED?
TLNE B,400 ; ..
JRST STOERR ;ERRORS.
TLNE B,1000 ;EOF?
JRST STOEOF ; YES.
PUSHJ P,TIMEOK ;UPDATE TIME.
JRST STOL ;LOOP TILL CONNECTION CLOSES
;HERE TO READ PAGED MODE FROM NET
STOTYX: SETO A, ;RELEASE ANY PREVIOUS WINDOW
MOVE B,[400000,,<WINDOW/1000>]
MOVEI C,0 ;NO COUNT
PMAP
SKIP WINDOW ;TOUCH IT TO CREATE PRIVATE PAGE.
MOVE A,DATJFN ;GET FIRST BYTE, SHOULD BE HDR LENGTH
BIN
JUMPE B,STXEFQ ;SEE IF EOF, IF ZERO
MOVEM B,MLFWST ;SAVE IT IN THIS BORROWED SCRATCH AREA
CAIL B,6 ;ALLOW A RANGE FOR GROWTH
CAILE B,12 ;SIX TO TEN SOUNDS FAIR
JRST STXFER ;FORMAT ERROR
MOVNI C,0(B) ;READ THAT MUCH HEADER
MOVE B,[444400,,MLFWST+1] ;IN THIS SAME SCRATCH AREA
SIN
JUMPN C,STXFER ;IF DIDN'T GET IT ALL, FORMAT ERR.
MOVE C,[MLFWST+1,,TYXHED] ;COPY IT TO REAL HEADER
BLT C,TYXHED+TYXHDN-1 ; ..
MOVE C,TYXNDW ;SEE HOW LONG THE DATA AREA IS
CAIL C,0
CAILE C,1000 ;UP TO A PAGE
JRST STXFER ;NO GOOD. FORMAT ERROR
MOVE B,[444400,,WINDOW] ;READ THE DATA INTO WINDOW
MOVNI C,(C)
SKIPE C ;IN CASE DATA AREA EMPTY
SIN
JUMPN C,STXFER ;MUST GET IT ALL, ELSE FORMAT ERR
AOS C,TYXSCT ;CHECK SEQUENCE COUNTER
CAME C,SEQNO ; ..
JRST STXSQE ;NO GOOD.
PUSHJ P,PGCKSS ;CHECKSUM TO A
JUMPN A,STXCKE ;CHECKSUM ERROR IF NON-ZERO
TLNE F,L.LDSK ;NOW, IS THIS TO A DISK?
JRST STXDSK ;YES. GO PAGE IT OUT
SKIPE RECTYP ;DATA RECORD?
JRST STOEFQ ;NO. IGNORE IT.
MOVN C,TYXNDW ;FOR NON-DISK, RETURN TO OLD CODE
PUSH P,[444400,,WINDOW] ;SET STACK WITH SIN POINTERS
PUSH P,C
MOVEI C,0 ;AS IF SIN READ WHOLE BLOCK
JRST STONN ;AND GO PROCESS THE WINDOW.
STXDSK: MOVN A,RECTYP ;SEE WHAT TYPE IT IS
JUMPE A,STXDDT ;IF ORDINARY DATA, GO MAP OUT.
CAIE A,3 ;EOF?
JRST STOEFQ ;NO, IGNORE (FOR EXPANSION)
STXEOF: MOVE A,TYXNDW ;SEE IF THIS LOOKS LIKE AN FDB
CAIL A,25
CAILE A,30
JRST STXFER ;NO, I DON'T THINK SO.
MOVSI D,-NFDBMX ;YES. PROCESS STUFF IN FDB
STXEFL: MOVE A,LCLJFN ;MAKE FDB POINTER
HRL A,FDMXT1(D) ;OFFSET INTO FDB
MOVE B,FDMXT2(D) ;MASK FOR IT
XCT FDMXT3(D) ;HOW TO GET DATUM FOR IT
CHFDB ;CHANGE THE DATUM
AOBJN D,STXEFL ;LOOP THRU TABLES
JRST STOEFQ ;AND GO WRAP IT UP.
FDMXT1: EXP 1,11,12,24 ;WORDS OF FDB TO SET
NFDBMX==.-FDMXT1
FDMXT2: 400001,,0 ;TMP AND EPH BITS
77B11 ;BYTE SIZE
-1 ;EOF POINTER
-1 ;USER SETTABLE WORD
FDMXT3: MOVE C,WINDOW+1
MOVE C,WINDOW+11
MOVE C,WINDOW+12
MOVE C,WINDOW+24
STXDDT: MOVE A,[400000,,<WINDOW/1000>] ;FROM FORK SPACE (PRIVATE)
MOVE B,PAGNO ;TO FILE PAGE
HRL B,LCLJFN ; ..
MOVSI C,040000 ;WRITE ACCESS
PMAP
MOVE A,B ;FILE HANDLE
MOVE B,ACCESS ;SET PAGE ACCESS
SPACS
SETO A,0 ;FREE THE WINDOW ADDRESS
MOVE B,[400000,,<WINDOW/1000>]
MOVEI C,0 ;NO COUNT
PMAP
JRST STOEFQ ;AND MOVE ON TO NEXT PAGE OR EOF FDB
STXEFQ: MOVE A,DATJFN ;GOT A ZERO AS FIRST BIN
GTSTS ;EOF, ERRORS OR CLOSED?
TLNE B,600000
TLNE B,400
JRST STOERR ;ERRORS.
TLNN B,1000 ;EOF?
JRST STXFER ;NO. FORMAT ERROR.
MOVN C,RECTYP ;YES. WAS LAST RECORD THE FDB?
CAIE C,3 ; ..
JRST STXFER ;NO. FORMAT ERROR.
JRST STOEF1 ;YES. CLOSE UP SHOP.
STONSS: TRNE F,R.RLPT ;TO SPOOLER?
JRST STSLPT ;YES. STORE SPOOLED LINE PRINTER
SKIPLE B,$TYPE ;NOT SAME SIZE. ASCII?
CAIE B,TY.I ;OR LOCAL BYTE
JRST STON1 ;YES. JUST SHIP IT OUT
PUSH P,C ;NO. IMAGE. HAVE TO SHUFFLE BITS.
SETZM WINDW2 ;CLEAR THE WINDOW
MOVE A,[WINDW2,,WINDW2+1]
BLT A,WINDW2+777 ; ..
MOVSI A,-1100 ;THIS MANY INPUT BYTES FROM NET
MOVSI B,-10 ;EIGHT STATE COUNTER
MOVE C,[-1000,,WINDW2] ;DESTINATION IS ONE PAGE HERE
STONSB: AOBJP A,.+2 ;COUNT THRU SOURCE
MOVE T2,WINDOW(A) ;GET TWO WORDS MAKING UP RESULT
MOVE T1,WINDOW-1(A) ; ..
LSH T1,-4 ;BUTT THEM TOGETHER
LSHC T1,@IMOSHT(B) ;MOVE THEM LEFT TO GET 36 GOOD BITS
MOVEM T1,0(C) ;AND STORE THE GOOD BITS
AOBJN C,.+1 ;COUNT OUTPUT WORDS
AOBJN B,STONSA ;END OF GROUP OF EIGHT?
AOBJN A,.+1 ;YES. HAVE TO DIDDLE POINTER
MOVSI B,-10 ;AND RESTART STATE COUNTER.
STONSA: JUMPL A,STONSB ;IF MORE TO GO, LOOP.
POP P,C ;COUNT LEFT AFTER READ FROM NET
POP P,D ;COUNT DESIRED FROM NET
POP P,B ;WHERE STORED FROM NET
SUB C,D ;COUNT GOTTEN FROM NET
TLNE B,4000 ;4 OR 1 PER WORD?
LSH C,2 ;ONE. MOVE OVER TO BYTES COUNT AT 4/WD
LSH C,3 ;BITS AT 32 PER WORD
ADDM C,IBITCT ;COUNT BITS
ADDM C,TRBITS ;ADD TO TOTAL FOR THIS LOGIN
IDIVI C,44 ;WORDS AT 36 BITS PER
SKIPE D
ADDI C,1 ;PARTIAL WORD
MOVNS C ; -WORDS TO WRITE ON DISK
MOVE B,[444400,,WINDW2] ;WHERE THEY ARE IN CORE
STSLP1: HRRZ A,LCLJFN ;FILE TO WRITE ON
SOUT ;DO IT
JRST STOEFQ ;SEE IF DONE
IMOSHT:REPEAT 10,< EXP <.-IMOSHT+1>*4>
STSLPT: MOVE B,$BYTE
CAIN B,10 ;EIGHT BIT RECEIVE?
JRST STON1 ;YES. JUST COPY.
POP P,D ;ORIGINAL COUNT BEFORE SIN
POP P,B ;ORIGINAL SIN POINTER (UGH!! PUN!!)
SUB C,D ;POSITIVE WORDS READ
IMULI C,44 ;BITS FOR STATISTICS
ADDM C,IBITCT
ADDM C,TRBITS
IDIVI C,44 ;BACK TO WORDS
IMULI C,5 ;NOW CHARACTERS
MOVNS C ;MINUS FOR SOUT
MOVE B,[440700,,WINDOW] ;POINTER TO DATA
JRST STSLP1 ;GO SEND IT
STOEOF: MOVE A,$TYPE ;SEE IF NEED TO SET BIT COUNT
MOVE B,$BYTE
CAIE B,44 ;WORD SIZED?
CAIE A,TY.I ;OR NON-IMAGE?
JRST STOEF1 ;YES. OK AS IT IS
TLNN F,L.LDSK ;ON A DISK FILE?
JRST STOEF1 ;NO
CLOSK LCLJFN ;HAVE TO DIDDLE UP THE BIT COUNT
MOVSI B,7700 ;THIS FIELD
MOVSI C,100 ;ONE BIT BYTES
HRRZ A,LCLJFN
HRLI A,11 ;WORD IN FDB
CHFDB
MOVE C,IBITCT ;THIS MANY BITS
SETO B, ;FULL WORD QTY
HRLI A,12 ;THIS WORD
CHFDB
STOEF1: HRROI X,MESS99 ;DONE MESSAGE
JRST STOX9 ;SEND IT TO USER
STOERR: HRROI X,STOERM ;ERROR FRM NET
JRST STOX9
STOERM: ASCIZ /452 Data connection error. File not completed./
STOX0: HRROI X,STO506 ;CANT DO IT
JRST STOXX
STOX5: MOVEI X,STACTM ;NO ACCOUNT SPECIFIED
JRST STOXX
STOX4: MOVEI X,STO506
JRST STOXX
STOX8: MOVEI X,STOANX ;ERROR FOR LPT BY ANONYMOUS
JRST STOXX
STOX1:
STOX2: MOVEI X,STOLUZ
JRST STOXX
STOX3: MOVEI X,ACCESM
STOXX:
STOX9: SETO A, ;UNMAP THE WINDOW PAGES
MOVE B,[400000,,<WINDOW/1000>]
MOVEI C,0 ;NO COUNT
PMAP
ADDI B,1
PMAP
HRRI B,<WINDW2/1000>
PMAP
ADDI B,1
PMAP
CLOSE DATJFN
CLOSE LCLJFN
HRROI B,0(X)
JRST RPCRLP ;REPLY
STOLUZ: ASCIZ /450 Can't write such a file./
STACTM: ASCIZ /433 Account must be supplied to store files. Send ACCT./
SLOWM1: ASCIZ /050 Image mode is inefficient except in 36 bit bytes.
050 Use TYPE L instead if possible. Proceeding...
/
STXFER: JSP X,STOXX
ASCIZ /455 Format error in paged data during store./
STXCKE: JSP X,STOXX
ASCIZ /455 Checksum error in data block from network./
STXSQE: JSP X,STOXX
ASCIZ /455 Sequence error in data from network./
STOANX: ASCIZ /450 Anonymous users may not write on LPT./
ZDELE: SETZM JFNTXS ;NO NAME STRING YET
PUSHJ P,JBKINI ;SET UP FOR DELETE FILE REQUEST
MOVSI A,100000 ;OLD FILE REQUIRED
HRRI A,-2 ;OLDEST VERSION DEFAULT
MOVEM A,JBLOCK
MOVE B,SBP ;USER'S NAME STRING
MOVEI A,JBLOCK ;POINT TO DATA
GTJFN
JRST DELX1 ;NO SUCH FILE
MOVEM A,LCLJFN
PUSHJ P,JFNTXT ;STORE TEXT STRING FOR THIS FILENAME
LDB C,B ;MAKE SURE GOT TO EOL
JUMPN C,DELX2 ;NO. BAD SYNTAX.
DVCHR ;SEE WHAT THE DEVICE IS
TLNE B,777 ;DISK?
JRST DELX3 ;NO. ERROR.
HRRZ A,LCLJFN ;JFN
DELF ;DO THE DELETE
JRST DELX4 ;CAN'T. ASSUME ACCESS RIGHTS BAD
SETOM LCLJFN ;JFN RELEASED BY DELF JSYS
DELEOK: JSP B,DELXX
ASCIZ /254 Delete completed OK/
DELX1: JSP B,DELXX
ASCIZ /450 No such file - DELEte request/
DELX2: JSP B,DELXX
ASCIZ /550 Bad name syntax - DELEte request/
DELX3: JSP B,DELXX
ASCIZ /506 DELEte only implemented for DISK files/
DELX4: JSP B,DELXX
ASCIZ /451 You do not have access rights to delete /
DELXX: CLOSE LCLJFN
MOVE A,REPLYP
TLO B,-1
MOVEI C,0
SOUT ;PART OF MESSAGE TO REPLY BUFFER
SKIPN JFNTXS ;A FILE NAME?
JRST DELXX1 ;NO
HRROI B,[ASCIZ / - file /]
SOUT
HRROI B,JFNTXS
SOUT ;YES, TACK ON FILENAME
DELXX1: MOVEM A,REPLYP
HRROI B,[ASCIZ /./]
JRST RPCRLP ;RETURN A MESSAGE
ZRNFR: MOVE B,SBP ;RENAME FROM. JUST COLLECT STRING
MOVE A,[440700,,$PTHS1] ;WHERE TO STASH IT
MOVNI C,<5*40>-2 ;LENGTH
SOUT
HRROI B,[ASCIZ /200 Rename-from name stored./]
JRST RPCRLP ;SEND THIS BACK
ZRNTO: SETOM $PATH1 ;NO JFN'S HERE YET
SETOM $PATH2 ; ..
PUSHJ P,JBKINI
MOVSI A,600000 ;OUTPUT NEW FILE ONLY
MOVEM A,JBLOCK
MOVEI A,JBLOCK
MOVE B,SBP ;POINTER TO USER'S STRING
GTJFN ;SEE IF THE FILE IS THERE
JRST RNMX1 ;CANT GET "TO" JFN
MOVEM A,$PATH2
PUSHJ P,JBKINI ;OK. TRY THE FROM JFN
MOVSI A,100000 ;OLD FILE ONLY
MOVEM A,JBLOCK ; ..
MOVEI A,JBLOCK ;POINT TO PARAMS
HRROI B,$PTHS1 ;STORED FROM RNFR COMMAND
GTJFN
JRST RNMX3 ;NOT THERE
MOVEM A,$PATH1 ;STORE JFN
MOVE B,$PATH2 ;OK, GET NEW NAME
RNAMF ;DO THE RENAME
JRST RNAMX5 ;CAN'T
SETOM $PATH1 ;GOOD. THIS JFN NOW GONE.
MOVE A,$PATH2
PUSHJ P,JFNTXT
JSP B,RNMXX
ASCIZ /253 Rename completed OK./
RNMX1: CAIE A,GJFX20 ;ERRORS FOR FILE EXISTS ALREADY
CAIN A,GJFX27 ; ..
JRST RNMX1A
JSP B,RNMXX
ASCIZ /455 Can't get JFN for New file name./
RNMX1A: JSP B,RNMXX
ASCIZ /456 "New Name" already exists. Delete it first./
RNMX2: JSP B,RNMXX
ASCIZ /451 No access rights to create new file./
RNMX3: JSP B,RNMXX
ASCIZ /450 Old named file not found./
RNMX4: JSP B,RNMXX
ASCIZ /451 No access rights to delete old filename./
RNMX5: JSP B,RNMXX
ASCIZ /455 Rename request unexpectedly failed./
RNMXX: PUSH P,B
CLOSE $PATH1
CLOSE $PATH2
POP P,B
TLO B,-1
JRST RPCRLP
;LIST, NLST AND STAT COMMANDS
;OUTER LEVEL SETS UP FOR DATA OR TELNET CONNECTION, THEN CALLS DOLIST
ZLIST: TRZA F,R.NLST ;LIST, NOT NLST
ZNLST: TRO F,R.NLST ;NLST, NOT LIST.
SKIPG $MODE ;BETTER BE AN ASCII CONNECTION
SKIPLE $STRU ; ..
JRST LISTX0 ;NOT.
TLZ F,L.STAT ;TELL DOLIST IT'S A LIST, NOT STAT.
SETOM $BYTE ;FORCE 8-BIT
SETOM $TYPE ;ASCII
TLO F,L.SEND ;SET UP A SEND CONNECTION
PUSHJ P,PREDAT ; ..
JRST RPCRLP ;NO GOOD.
HRROI B,[ASCIZ /250 List started.
/]
PUSHJ P,SDUMPA ;SEND MSG AND DUMP BUFFER TO SJFN
MOVE A,DATJFN ;WHERE DOLIST SHOULD SEND ANSWERS
PUSHJ P,DOLIST
LIST02: MOVE A,DATJFN
CLOSF ;DONE WITH THE DATA CONNECTION
JFCL
SETOM DATJFN
HRROI B,MESS99 ;252 DONE MESSAGE
JRST RPCRLP
LISTX0: HRROI B,[ASCIZ /506 Parameter error in LIST command./]
JRST RPCRLP
ZSTAT: TLO F,L.STAT ;TELL DOLIST IT'S A STAT, NOT LIST.
TRZ F,R.NLST ;OR NLST
MOVEI A,101 ;DATA GOES TO PRIMARY OUTPUT
PUSHJ P,DOLIST ;DO THE WORK
JRST GETCOM ;DONE.
;DOLIST IS THE GUTS OF BOTH LIST AND STAT.
DOLIST: MOVEM A,LSTJFN ;SAVE THE DESTINATION.
REPEAT 0,<
SKIPE ARGCH ;BLANK ARGUMENT?
JRST DOLI01 ;NO.
HRROI B,[ASCIZ /100 /] ;PREFIX IF ON TELNET CONNECTION
MOVEI C,0
TLNE F,L.STAT ;LIST OR STAT?
SOUT ;STAT.
HRROI B,LHSTNM ;TYPE SERVER HOST NAME
SOUT
HRROI B,[ASCIZ / FTP Server /]
SOUT
HRROI B,VERSTR
SOUT
TRO F,R.T1 ;PRETEND NEED A CRLF
JRST DOLIZ1 ;OUTPUT CRLF AND 200 REPLY
>
DOLI01: TLZ F,L.PDIR ;CLEAR FLAGS USED BELOW
TRZ F,R.T1!R.T2 ; ..
PUSHJ P,JBKINI ;SEE IF HIS STRING MAKES SENSE
HRROI T1,[ASCIZ /*/] ;SET UP FOR DEFAULTS
MOVEM T1,JBLOCK+4
MOVEM T1,JBLOCK+5 ;NAME AND EXT
MOVSI T1,100100 ;FLAGS TO ALLOW WILD, OLD FILES
TRNN F,R.NLST ;UNLESS NLST COMMAND,
HRRI T1,-3 ;"STAR" FOR VERSION DEFAULT
MOVEM T1,JBLOCK ; ..
MOVEI A,JBLOCK ;ARG TO GTJFN
MOVE B,SBP ;POINTER TO USER'S REQUEST
GTJFN
JRST DOLIX1 ;NO GOOD
MOVEM A,LCLJFN ;SAVE IT
TLNN A,(77B5) ;ANY WILD CARDS?
JRST DOLINS ;NO STARS
TLNE A,(70B5) ;WILD DEV OR DIR?
JRST DOLIX3 ;YES. DONT ALLOW WHOLE DUMPS.
TRNN F,R.NLST ;UNLESS NLST COMMAND,
TLO F,L.PDIR ;PRINT DIRECTORY NAME FIRST TIME
;FALL THRU
DOLIL1: PUSHJ P,TIMEOK ;UPDATE TIME KILL.
DOLI04: MOVE A,LSTJFN ;LIST THE FILE NAME
HRROI B,[ASCIZ /151 /] ;HEADER.
MOVEI C,0
TRON F,R.T1 ;NEED A CR. ALREADY STARTED LINE?
TLNN F,L.STAT ;NO. NEED THE HEADER?
SKIPA
SOUT ;NEW LINE AND NEED HEADER
MOVEI B,"," ;SEPARATING VERSIONS ONLY?
TRNE F,R.T2 ; ..
BOUT ;YES.
HRRZ B,LCLJFN ;THE FILE NAME TO BE LISTED
TLZN F,L.PDIR ;WANT DIRECTORY NAME?
JRST DOLI03 ;NOT NOW
MOVE C,[110000,,1] ;ONLY DIR NAME, PUNCTUATED
JFNS ;OUTPUT IT
HRROI B,CRLFM ;FORCE AN END OF LINE HERE.
MOVEI C,0
SOUT
TRZ F,R.T1 ;AND SAY NOT STARTED THIS LINE
JRST DOLI04 ;BACK TO PRINT FILE NAME
DOLI03: MOVE C,[201110,,040001] ;FORMAT
TRZE F,R.T2 ;JUST A NEW VERSION?
MOVSI C,(1B14) ;YES. JUST PRINT THAT.
TRNE F,R.NLST ;BUT IF NLST, SEND DIFFERENT FORMAT.
MOVE C,[211111,,140001]
JFNS ;PRINT SOMETHING.
DOLIN1: MOVE A,LCLJFN ;STEP THE HANDLE
GNJFN ; ..
JRST DOLIZ1 ;NO MORE.
TRNE F,R.NLST ;NLIST COMMAND?
JRST DOLIN2 ;YES. ALWAYS SEPARATE LINES.
TLNN A,16 ;JUST VERSION CHANGE?
JRST DOLI02 ;YES.
TLNE A,(GN%STR!GN%DIR) ;NEW DIRECTORY OR STRUCTURE?
TLO F,L.PDIR ;YES. WANT TO MENTION IT.
DOLIN2: HRROI B,CRLFM ;NO. END LINE.
MOVE A,LSTJFN
MOVEI C,0
TRZE F,R.T1 ;IF ONE STARTED.
SOUT
JRST DOLIL1 ;LOOP TO NEXT FILE.
DOLI02: TRNE F,R.T1 ;STARTED A LINE?
TRO F,R.T2 ;YES. THEN EXT IS ALL THAT CHANGES
JRST DOLIL1 ;LOOP
DOLINS: HRRZ A,LSTJFN ;JUST ONE FILE. NO STARS.
HRROI B,[ASCIZ /150 /]
MOVEI C,0
TLNE F,L.STAT ;CUE NEEDED?
SOUT ; YES
HRRZ B,LCLJFN ;GET THE FILE JFN
MOVE C,[211111,,176011] ;QFD FORMAT
TRNE F,R.NLST ;BUT IF NLST, SEND DIFFERENT FORMAT.
MOVE C,[211111,,140001]
JFNS
TROA F,R.T1 ;SAY NEED CRLF
DOLIZ1: SETOM LCLJFN ;GNJFN COUNTING OUT RELEASED IT
MOVE A,LSTJFN
HRROI B,CRLFM ;OUTPUT EOL IF NEEDED
MOVEI C,0
TRZE F,R.T1 ; ..
SOUT
HRROI B,[ASCIZ /200 End of status.
/]
TLNE F,L.STAT ;ON TELNET CONN?
SOUT ;YES. FLAG END.
POPJ P,0 ;RETURN FROM DOLIST
DOLIX1:
DOLIX2: CLOSE LCLJFN
HRROI B,[ASCIZ /450 /] ;FILE STATUS
MOVE A,LSTJFN ;OUTPUT JFN
MOVEI C,0 ; ..
TLNE F,L.STAT ;NEED CUE?
SOUT ;YES.
HRROI B,[ASCIZ /? Not found.
/]
SOUT
POPJ P,0
DOLIX3: HRRZ A,LCLJFN ;CLOSE JFN WHICH HAS TOO MANY STARS
CLOSF
JFCL
SETOM LCLJFN
HRROI B,[ASCIZ /451 /]
MOVE A,LSTJFN
MOVEI C,0
TLNE F,L.STAT ;HEADER NEEDED ON TTY CONN?
SOUT ;YES.
HRROI B,[ASCIZ /* not allowed for device or directory./]
SOUT
POPJ P,0
JBKINI: SETZM JBLOCK ;SET UP FOR LONG FOR GTJFN
MOVE A,[JBLOCK,,JBLOCK+1]
BLT A,EJBLOK ;CLEAR IT FIRST
MOVSI A,377777 ;NO TTY I/O
HRRI A,377777 ; ..
MOVEM A,JBLOCK+1 ; ..
POPJ P,0 ;RETURN
JFNTXT: PUSH P,A ;PRESERVE AC'S
PUSH P,B
PUSH P,C
SETZM JFNTXS ;CLEAR TEXT STORAGE
MOVE A,[JFNTXS,,JFNTXS+1]
BLT A,EJFNTX ; ..
HRRZ B,-2(P) ;THE JFN
HRROI A,JFNTXS ;STORE STRING HERE
MOVE C,[211110,,1] ;FORMAT
JFNS
POP P,C
POP P,B
POP P,A
POPJ P,0
;SUBROUTINE CALLED BY COMMANDS WHICH NEED THE DATA CONNECTION.
; PREPARES THE DATA SOCKET, SENDS THE 255 SOCKET REPLY, AND
;THEN OPENS THE CONNECTION.
;SKIP RETURN IF OK, ELSE NON-SKIP WITH ERROR MSG IN B.
;ARGUMENTS ARE L.SEND (FOR DIRECTION) AND THE SOCKET/HOST/BYTE PARAMS
PREDAT:
PRED1: SKIPGE A,DATJFN ;CONNECTION ALREADY THERE?
JRST PRED2A ;NO.
GTSTS ;YES. IS IT THE RIGHT KIND?
TLNN B,(1B0) ;OPEN?
JRST PRED2 ;NO. FLUSH.
TLNE F,L.SEND ;YES. RIGHT DIRECTION?
TLNN B,(1B2) ;SENDING AND OPEN FOR WRITE?
JRST PRED1A ;NO
PUSHJ P,PRE255 ;YES. SEND SOCKET REPLY,
JRST PRED3 ; AND USE IT AGAIN
PRED1A: TLNN F,L.SEND ;RECEIVING?
TLNN B,(1B1) ;AND OPEN FOR READ?
JRST PRED2 ;NO
PUSHJ P,PRE255 ;SEND SOCKET REPLY
JRST PRED3 ;AND USE IT
PRED2: CLOSF ;GET RID OF OLD CONNECTION
JFCL ;IF CAN'T, JUST GET ANOTHER JFN
PRED2A: SETOM DATJFN ;NO USEFUL OLD CONNECTION
MOVE A,[440700,,GTJSTR] ;POINTER TO BUILD A NEW SOCKET NAME
HRROI B,[ASCIZ /NET:/]
MOVEI C,0
SOUT ;START IT.
MOVEI B,2 ;LOCAL SOCKET IS 2 OR 3, JOB RELATIVE.
TLNE F,L.SEND ;WRITE CONNECTION?
ADDI B,1 ;YES, MAKE IT ODD
MOVEI C,10 ;OCTAL NUMBER IN NCP
NOUT
PUSHJ P,BOMB
;FALL THRU
;FALLS IN FROM ABOVE
PRED2B: MOVEI B,"." ;SEPARATE FROM DISTANT FIELD
IDPB B,A ; ..
SKIPGE B,$HOST ;FOREIGN HOST SPECIFIED?
MOVE B,FHSTN ;NO, DEFAULT IS WHERE TELNET IS FROM
MOVEI C,10
NOUT
PUSHJ P,BOMB
MOVEI B,"-" ;FLAG FOR SOCKET
IDPB B,A
SKIPGE B,$SOCK ;FOREIGN SOCKET SPECIFIED?
JRST [MOVE B,FORNS ;NO, GET TELNET CONN SOCKET
ADDI B,2 ;PLUS 2 TO RECEIVE
TLNN F,L.SEND ;OR IS HE SENDING?
ADDI B,1 ;YES. MAKE HIS ODD NUMBER
JRST .+1]
MOVEI C,10 ;SOCKET IN OCTAL
NOUT
PUSHJ P,BOMB
HRROI B,[ASCIZ /;T/] ;JOB-LOCAL SOCKET
MOVEI C,0
SOUT
PUSHJ P,TIMEOK ;UPDATE TIMER CLOCK
PRED2C: MOVSI A,1 ;NOW TRY TO GET THE SOCKET
HRROI B,GTJSTR ; ..
GTJFN
JRST PREDX1 ;CAN'T?
MOVEM A,DATJFN ;OK, SAVE THE JFN
CVSKT ;NOW GET THE SOCKET NUMBER (ABSOLUTE)
JRST PREDX2 ;CAN'T?
TLNN F,L.SEND ;MAKE SURE SEX BIT IS RIGHT
TRZA B,1 ; ..
TRO B,1 ;SENDING
MOVEM B,MYDATS ;SAVE IT
PUSHJ P,PRE255 ;NOW SEND THE 255 REPLY
;FALL THRU AGAIN. THIS IS A BIG STRAIGHT LINE ROUTINE
;FALLS IN FROM ABOVE
PRED2D: PUSHJ P,TIMEOK ;UPDATE TIMER
SKIPG B,$BYTE ;GET BYTE SIZE
MOVEI B,10 ;DEFAULT IS 8-BIT
LSH B,36 ;TO OPENF FLAG WORD
TLNE F,L.SEND ;SEE WHICH WAY TO POINT IT
TDOA B,[002400,,100000] ;WRITE, BUFFERED SEND
TRO B,1B19 ;READ.
MOVE A,DATJFN ;NOW DO THE CONNECT
OPENF ; ..
JRST PREDX2 ;CAN'T
PRED3: JRST CPOPJ1 ;SUCCESS RETURN FROM PREDAT
PREDX2: MOVE A,DATJFN ;COULDN'T OPEN OR CVSKT
RLJFN ;FREE THE JFN
JFCL
PREDX1: SETOM DATJFN ;FLAG NOT THERE
HRROI A,STRTMP ;BUILD ERROR MSG HERE
HRROI B,[ASCIZ /454 Data connection failed: /]
MOVEI C,0
SOUT
HRLOI B,400000
MOVEI C,0
ERSTR
JFCL
JFCL
HRROI B,STRTMP ;POINT TO MSG
POPJ P,0 ;FAIL RETURN
PRE255: HRROI A,[ASCIZ /255 SOCK /]
PSOUT ;SEND SERVER SOCKET REPLY IN SPECIFIED
MOVEI A,101 ; FORMAT, OVER TELNET SOCKET
MOVE B,MYDATS ; ..
MOVEI C,12 ;NETWORK VIRTUAL RADIX
NOUT
PUSHJ P,BOMB
HRROI A,CRLFM
PSOUT
POPJ P,0
.ORG ;BACK TO LOW SEGMENT
;CONSTANTS
DEFINE M1 (A,B) <
IFNDEF Z'A, <Z'A==NOTIMP>
>
KEYMAC
PDP: IOWD PDLL,PDL ;STACK POINTER
L1PDP: IOWD PDLL,L1PDL ;LEV 1 PSI STACK
L2PDP: IOWD PDLL,L2PDL ;LEV 2 PSI STACK
DBUGSW: 0 ;NONZERO FOR DEBUGGING
ONCHNS: 770547,,507777 ;CHANNELS ON IN PSI SYSTEM
LEVTAB: RETPC1 ;RETURN PC'S
RETPC2
RETPC3
CHNTAB: REPEAT ^D9,<0> ;FIRST TERM PSI GROUP, OV'S
1,,PDLINT ;PDLOV
0 ;EOF
2,,IOXINT ;IO DATA ERROR
2,,QTAINT ;12 QUOTA EXCEEDED
0 ;13 UNDEF FILE INT'S
0 ;14 TIME OF DAY
1,,INSINT ;15 ILLEG INSTRUCTION INT
REPEAT 3,<1,,MEMINT> ;16-18 MEMORY ILLEGAL REF'S
0 ;FORK TERM
1,,FULINT ;20 MACHINE SIZE EXCEEDED
REPEAT 3,<0> ;TRAP TO USER, NEW PAGE, NOT USED
2,,TIMINT ;24 TIMING FORK INT
2,,CTCINT ;25 CONTROL C (OR E IN DEBUG)
2,,DETINT ;26 DETACH INTERRUPT
REPEAT ^D9,<0> ;UNUSED
IFN <.-44-CHNTAB>,<PRINTX ;CHNTAB NOT 36 LONG>
INFMSG: 1,,1 ;MESSAGE TO INFO
0 ;NO COPY
ASCIZ /[SYSTEM]FTSCTL/ ;GET A PID FOR THIS NAME
ENDMSG==.
PATCHX=VERSIO ;UPDATE VERSION NUMBER IF PATCHED
PAT:
PATCH: BLOCK 200 ;FOR PATCHING THE BINARY
;END OF ALL CODE. NOW THE LITERALS.
XLIST ;LIT STATEMENT
LIT
LIST
CODTOP: ;THIS IS THE END OF THIS MODULE EXCEPT FOR PRIVATE PAGES
LOC <<.+777>&777000> ;PAGE BOUNDARY FOR PRIVATE AREAS
VARADR==. ;FOR PMAPPING SPACE AWAY
;VARIABLES
RETPC1: BLOCK 1 ;RETURN PC'S FOR PSI SYSTEM
RETPC2: BLOCK 1
RETPC3: BLOCK 1 ; ..
GJINF1: BLOCK 1 ;RESULTS OF GJINF AT START AND LOGIN
GJINF2: BLOCK 1
GJINF3: BLOCK 1
GJINF4: BLOCK 1
KEYWRD: BLOCK 1 ;THE SIXBIT COMMAND VERB
ARGWRD: BLOCK 1 ;THE SIXBIT ARG FOR SOME COMMANDS
PRVKWD: BLOCK 1 ;PREVIOUS KEYWRD, FOR SEQUENCE-
; DEPENDANT COMMANDS RNTO, PASS
PI1AC: BLOCK 20 ;STORAGE FOR LEV 1 AC'S
PI2AC: BLOCK 20 ;STORAGE FOR LEV 2 AC'S
PDL: BLOCK PDLL ;SPACE FOR STACK
L1PDL: BLOCK PDLL ;ANOTHER ON LEV 1 PSI
L2PDL: BLOCK PDLL ;AND ANOTHER ON LEV 2
LHOSTN: BLOCK 1 ;LOCAL HOST NUMBER IN OCTAL
LHSTNM: BLOCK 20 ;LOCAL HOST NAME IN ASCIZ
$ACCES: BLOCK 3 ;ARGUMENT BLOCK FOR ACCESS JSYS
$USER: BLOCK 11 ;USER NAME TEXT STRING
$PASS: BLOCK 11 ;PASSWORD TEXT STRING
$ACCT: BLOCK 12 ;ACCOUNT WORD OR STRING
$CWD: BLOCK 1 ;DIR NUM OF CWD COMMAND
$BYTE: BLOCK 1 ;BYTE SIZE OF DATA CONNECTION
$SOCK: BLOCK 1 ;SOCKET NUMBER IF SENT BY USER
$HOST: BLOCK 1 ;HOST NUMBER FOR DATA IF SENT BY USER
$TYPE: BLOCK 1 ;TYPE ARGUMENT FROM USER
$MODE: BLOCK 1 ;MODE ARGUMENT FROM USER
$STRU: BLOCK 1 ;STRUCTURE ARGUMENT FROM USER
$PATH1: BLOCK 1 ;JFN FOR RENAME FROM
$PATH2: BLOCK 1 ;JFN FOR RENAME TO
$PTHS1: BLOCK 40 ;STRING SPACE FOR NAME IN RNFR
ANOPSW: BLOCK 10 ;WHERE TO STORE ANONYMOUS'S PASSWORD
; FROM SYSTEM TEXT FILE
USERNM: BLOCK 1 ;USER NUMBER (RCUSR($USER))
PRGJFN: BLOCK 1 ;JFN FROM RMAP OF THIS PROGRAM
USRFCT: BLOCK 1 ;BAD USER NAMES COUNTER
PASFCT: BLOCK 1 ;PASSWORD FAILURE COUNTER
TFORKX: BLOCK 1 ;FORK HANDLE OF TIMING FORK
KTIMET: BLOCK 1 ;TIME WHEN JOB WILL BE KILLED BY
; TIME OF DAY INTERRUPT
IOXFLG: BLOCK 1 ;FLAG SET BY IO ERR PSI
CTCFLG: BLOCK 1 ;FLAG SET BY ^C PSI
LGOCNT: BLOCK 1 ;COUNTER TO FORCE LOGOUT ON TIME.
CMDIB: BLOCK LCMDIB ;THE TELNET LINE COLLECTED FROM NET
SBP: BLOCK 1 ;BYTE POINTER AS COMMAND IS SCANNED
REPLYM: BLOCK LREPLY ;AND ANSWER BEING BUILT FOR REPLY
REPLYP: BLOCK 1 ;POINTER TO REPLY BEING BUILT
SYSDNM: BLOCK 1 ;DIR NUMBER OF SYSTEM
ANODNO: BLOCK 1 ;USER NUMBER OF ANONYMOUS
LCLJFN: BLOCK 1 ;JFN OF LOCAL MAIL FILE, TEMP FILES
IBITCT: BLOCK 1 ;BIT COUNT FOR LOGGING
TSBITS: BLOCK 1 ;BITS SENT IN A RETR
MLUNST: BLOCK 21 ;NAME OF UNKNOWN MAIL ADDRESSEE
ACTACS: BLOCK 20 ;AC STORAGE FOR FORWARDER FORK
STRTMP: BLOCK 60 ;ANOTHER STRING STORAGE SPACE
DATJFN: BLOCK 1 ;DATA CONN JFN IF MLFL
FHSTN: BLOCK 1 ;NUMBER OF FOREIGN HOST
FORNS: BLOCK 1 ;EVEN NUMBERED FOREIGN NVT SOCKET
MYDATS: BLOCK 1 ;CVSKT OF MY DATA CONNECTION
GTJSTR: BLOCK 60 ;SPACE TO BUILD A FILENAME STRING
IPCDAT: BLOCK 100 ;DATA AREA FOR MSGS TO/FROM IPCF
PIDARG: BLOCK 10 ;ARG BLOCK FOR IPCF CALLS
CTLPID: BLOCK 1 ;PID OF FTSCTL
MYPID: BLOCK 1 ;PID OF ME
IFRKTM: BLOCK 1 ;TIME METER FOR LOGGING
LOGJFN: BLOCK 1 ;JFN OF LOG FILE FOR PMAPPING MAIL STAT
LSTJFN: BLOCK 1 ;JFN WHERE LIST OR STAT GOES.
MALCPU: BLOCK 1 ;MORE METERING
MLFWST: BLOCK 30 ;NAME FOR FORWARDING
LPTSTR: BLOCK 30 ;ARG OF XLPTF COMMAND
MLTIMT: BLOCK 1 ;TEMP FOR GMT TIME COMPUTATION
MLUSR: BLOCK 1 ;DIRECTORY NUMBER OF MAIL RECIPIENT
NBUFN: BLOCK 1 ;GETAB INDEXES FOR NET TABLES
NSTSN: BLOCK 1 ; ..
NETAWD: BLOCK 1 ;TABLE ENTRIES FOR THE NVT
NETLSK: BLOCK 1 ; ..
NETSKX: BLOCK 1 ;INDEX INTO NET TABLES FOR THE NVT
TRBITS: BLOCK 1 ;BITS RECEIVED IN MAIL
LWORDS: BLOCK 1 ;FILE LENGTH IN WORDS
FDBBLK: BLOCK 31 ;AREA TO HOLD AN FDB
FDBBKE=.-1 ;END FOR BLT TO CLEAR
JBLOCK: BLOCK 11 ;ARG BLOCK FOR LONG GJTFN
EJBLOK==.-1
JFNTXS: BLOCK 60 ;TEXT STRING FROM JFNS
EJFNTX==.-1
TYXSCT: BLOCK 1 ;SEQUENCE COUNTER FOR TYPE XTP
;DO NOT SEPARATE THE NEXT FEW. THEY ARE THE "TYPE XTP" HEADER
TYXHED: BLOCK 0 ;TAG THE HEADER AREA
CHKSUM: BLOCK 1 ;CHECKSUM OF THE DATA CHUNK
SEQNO: BLOCK 1 ;SEQUENCE NUMBER OF THE CHUNK
TYXNDW: BLOCK 1 ;NUMBER OF DATA WORDS GOES HERE
PAGNO: BLOCK 1 ;PAGE NUMBER IN DISK FILE
ACCESS: BLOCK 1 ;RPACS ARG FOR DISK FILE
RECTYP: BLOCK 1 ;TYPE OF NET CHUNK
TYXHDN==6 ;LENGTH OF THIS HEADER
;END OF UNSEPARABLE STUFF
;NOW THE VARIABLE STORAGE:
VAR
;END OF EVERYTHING
VARTOP:
LOC <<.+777>&777000>
WINDOW: BLOCK 1000
WINDW2: BLOCK 1000 ;TWO PAGES FOR MAPPING FILES
BLTADR: BLOCK 1000 ;PAGE FOR MAPPING MAILBOX FORWARDER
WINDPN==WINDOW/1000
WND2PN==WINDW2/1000
BLTPAG==BLTADR/1000
IFN .&777,<PRINTX STORAGE NOT ON PAGE BOUNDARIES!!!>
EXP 123 ;CONVINCE LOADER TO PUT SYMBOLS ABOVE HERE
END GO