Trailing-Edge
-
PDP-10 Archives
-
BB-H138C-BM
-
5-sources/ftpser.mac
There are 4 other files named ftpser.mac in the archive. Click here to see a list.
;<5.ARPA-UTILITIES>FTPSER.MAC.6, 26-Jan-82 11:39:14, Edit by PAETZOLD
;Update for 96-bit leaders.....finally
;<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 (or NETSER.EXE) SYSTEM JOB
VWHO==0 ;last edited by SWE
VMAJOR==5 ;MAJOR VERSION #
VMINOR==0 ;REVISION #
VEDIT==^D18 ;EDIT NUMBER
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
LNMAIL==10 ;#12 Table size NOMAIL; dir numbers of those who can't
;#12 receive network mail
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
R.XRCP==40 ;#7 XRCP vs MAIL
;START ADDRESS OF THE TOP LEVEL OF FTP SERVICE
GO: RESET ;START HERE, CLEAN SLATE
MOVE A,[112,,11] ;#2 Determine whether TOPS20 or TENEX..
CALLI A,41 ;#2 ..
MOVEI A,30000 ;#2
SETZM TOPS20 ;#2 Assume TENEX
CAIN A,40000 ;#2 unless system says TOPS20
AOS TOPS20 ;#2
MOVE A,[440700,,REPLYM] ;#8 Init reply mechanism, in case
MOVEM A,REPLYP ;#8 of "PUSHJ P,BOMB"
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
SKIPN TOPS20 ;#2
MOVEI B,7 ;#2 TENEX NVT type is 7
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
MOVE A,GJINF4 ;TERMINAL NUMBER
TRO A,400000 ;DESIGNATOR
HRLI A,(1B0) ;CLEAR ADVICE
SKIPN TOPS20 ;#2 TOPS20 ADVIZ is in TLINK
JSYS 315 ;#2 ADVIZ (TENEX way)
ERJMP .+1 ;#2 convenient no-op
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
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
MOVX A,RC%EMO ;EXACT MATCH ONLY
HRROI B,[ASCIZ /ANONYMOUS/]
PUSHJ P,.RCUSR ;#2 See if ANONYMOUS is a user on this system
MOVEM C,ANODNO ;#2 Save possible user number (zero if none)
MOVE A,['JOBRT '] ;#2 Get size and table number for
SYSGT ;#2 "job runtime"
SKIPN B ;#2
PUSHJ P,BOMB ;#2 (fail cause we need size info)
MOVEM B,JOBRT ;#2
MOVE A,['JOBDIR'] ;#2
SYSGT ;#2 "job directory"
SKIPN B ;#2
MOVEI B,377777 ;#2 (illegal info, caught later)
MOVEM B,JOBDIR ;#2
MOVE A,['JOBTTY'] ;#2
SYSGT ;#2 "job controlling terminal"
SKIPN B ;#2
MOVEI B,377777 ;#2 (illegal info, caught later)
MOVEM B,JOBTTY ;#2
; ..
; ..
MOVEI A,.GTHNS ;#1 Get local host name and number..
HRROI B,LHSTNM ;#1
SETO C, ;#1
GTHST ;#1
PUSHJ P,BOMB ;#1 (shouldn't fail if we're on the net!)
MOVEM C,LHOSTN ;#1 save number
WHTNVT: MOVEI A,.GTNNI ;#1 Get info about our NVT terminal..
MOVE B,GJINF4 ;#1 (the input side)
MOVEI C,NCPBLK ;#1
MOVSI D,-20 ;#1 enuf room for things we need
GTNCP ;#1
JRST [ MOVE A,LHOSTN ;#1 must not be an NVT??
MOVEM A,FHSTN ;#1 assume local host,
SETOM FORNS ;#1 and hope we don't need
SETOM NETLSK ;#1 socket numbers!
JRST .+1] ;#1
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
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
; ..
; ..
GETPID:
IFN IPCLOG,<
SKIPN TOPS20 ;#2 TENEX doesn't support IPCF
JRST SIGON ;#2
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: MOVE A,[POINT 7,REPLYM] ;#8
HRROI B,[ASCIZ /300 /] ;#8 REQUIRED HELLO MESSAGE
PUSHJ P,.SOUT ;#8
HRROI B,LHSTNM ;#8 SITE NAME
PUSHJ P,.SOUT ;#8
HRROI B,[ASCIZ / FTP Service /] ;#8
PUSHJ P,.SOUT ;#8
LDB B,[POINT 9,VERSIO,11] ;GET MAJOR 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
IDPB B,A ;#8
VERSI0: HRRZI B,"A"(C) ;PRINT SECOND LETTER
IDPB B,A ;#8
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
IDPB B,A ;#8
HRRZ B,VERSIO ;GET EDIT NUMBER AGAIN
NOUT ;PRINT IT
JFCL
MOVEI B,")" ;PRINT CLOSE PAREN
IDPB B,A ;#8
VERSI2: LDB B,[POINT 3,VERSIO,2] ;GET GROUP CODE
JUMPE B,VERSI3 ;SKIP IF ZERO
MOVEI C,"-" ;#8 print -
IDPB C,A ;#8
ADDI B,"0" ;#8 print group code
IDPB B,A ;#8
VERSI3: repeat 0,< ;need directive to get this
HRROI B,[ASCIZ / %/]
MOVEI C,0
SOUT
MOVEI B,SRCVNO
MOVEI C,12
NOUT
JFCL
>
HRROI B,[ASCIZ / at /] ;#8
PUSHJ P,.SOUT ;#8
SETO B,0 ;CURRENT TIME STAMP
MOVSI C,200221 ;FORMAT OF TIME
ODTIM
MOVEM A,REPLYP ;#8 End of greeting (reply)
JRST CRLFRP ;#8 Show greeting, get 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 X,[ASCIZ /? Unknown error interrupt
/] ;#14
SKIPE CTCFLG ;WAS IT A ^C?
HRROI X,[ASCIZ /Interrupt by user
/] ;#14
SKIPE IOXFLG ;I/O ERROR?
HRROI X,[ASCIZ +System I/O Error
+] ;#14
HRROI A,[ASCIZ /456 /]
PSOUT
RETXX: ;#14
STOXX: SETO A, ;#14 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
BOMB: MOVE A,REPLYP
HRROI B,[ASCIZ /435 Fatal system error at /]
PUSHJ P,.SOUT ;#8
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 /]
PUSHJ P,.SOUT ;#8
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
HRLI B,440700 ;STRING POINTER (ALLOWS JSP B,RPCRLP)
PUSHJ P,.SOUT ;#8
HRROI B,CRLFM ;APPEND CRLF
PUSHJ P,.SOUT ;#8
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
PUSHJ P,.SOUT ;#8
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.
;.SOUT - copy ASCIZ string in core
; 1/ destination byte pointer
; 2/ source byte pointer (also -1,,string.loc)
; PUSHJ P,.SOUT
;Ret +1; always,
; 1,2/ updated byte pointers
; 3/ zero
.SOUT: TLC B,-1 ;#8 Insure (compose) byte pointer
TLCN B,-1 ;#8 to source string
HRLI B,440700 ;#8
ILDB C,B ;#8 Get character,
IDPB C,A ;#8 put character,
JUMPN C,.-2 ;#8 until nul found.
ADD A,[7B5] ;#8 Backup dest ptr (to overwrite nul)
POPJ P, ;#8
;.SOUTC - copy ASCIZ (or maximum char count) string in core
; 1/ destination byte pointer
; 2/ source byte pointer
; 4/ positive char limit
; PUSHJ P,.SOUT
;Ret +1; always,
; 1,2/ updated byte pointers
; 3/ zero
.SOUTC: TLC B,-1 ;#8 Insure (compose) byte pointer
TLCN B,-1 ;#8 to source string
HRLI B,440700 ;#8
SOUTC1: SOSGE C,D ;#8 Stop at limit
TDZA C,C ;#8
ILDB C,B ;#8 Get character,
IDPB C,A ;#8 put character,
JUMPN C,SOUTC1 ;#8 until nul found.
ADD A,[7B5] ;#8 Backup dest ptr (to overwrite nul)
POPJ P, ;#8
;.CVHST - translate host number into name
.CVHST: MOVEI C,10 ;#2
CVHST ;#2 Translate number into name
NOUT ;#2 error, show (octal) number instead
JFCL ;#2
POPJ P, ;#2
;.RCDIR - lookup directory name (add/remove necessary punctuation)
;.RCUSR - lookup user name (a PS: directory which is not files-only)
; Ret +1; always,
; A/ flags (error if RC%AMB or RC%NOM)
; C/ directory number (zero if error)
.RCUSR: SKIPN TOPS20 ;#2 Translate user name string..
JRST [ PUSHJ P,STDIR5 ;#2 TENEX way..
JUMPL A,RCERR ;#2 Must not be files-only!
POPJ P,] ;#2
RCUSR ;#2 TOPS20 has this JSYS
ERJMP RCERR ;#2 error
POPJ P, ;#2
.RCDIR: PUSH P,A ;#2 Translate directory name string..
TLC B,-1 ;#2 Make sure "pointer" to string
TLCN B,-1 ;#2 is a legitimate byte pointer
HRLI B,440700 ;#2
MOVE A,B ;#2 Scan string for TOPS20 format "str:<dir>"..
ILDB C,A ;#2 look until
CAIE C,"<" ;#2 directory punctuation
JUMPN C,.-2 ;#2 or end of string seen
SKIPN TOPS20 ;#2
JRST STDIR1 ;#2
JUMPN C,RCDIR4 ;#2 Required format?
MOVE A,[440700,,XSTDIR] ;#2 No, just directory name,
MOVEI C,"<" ;#2 so add punctuation..
IDPB C,A ;#2
ILDB C,B ;#2
JUMPN C,.-2 ;#2
MOVEI B,">" ;#2
IDPB B,A ;#2
IDPB C,A ;#2
MOVE B,[440700,,XSTDIR] ;#2 Ptr to proper format str
RCDIR4: POP P,A ;#2 Recover initial flags
RCDIR ;#2
ERJMP RCERR ;#2
POPJ P, ;#2
RCERR: TXO A,RC%NOM ;#2 Error of some sort,
SETZ C, ;#2 just call it "no match"
POPJ P, ;#2 and return zero number
STDIR1: JUMPE C,STDIR4 ;#2 Not TOPS20 format, easy handle
SKIPA B,[440700,,XSTDIR] ;#2 Strip away punctuation into here..
IDPB C,B ;#2
ILDB C,A ;#2 copy until
CAIE C,">" ;#2 directory punctuation
JUMPN C,.-3 ;#2 (or end of string?)
SETZ C, ;#2 make str ASCIZ
IDPB C,B ;#2
MOVE B,[440700,,XSTDIR] ;#2 String from here
STDIR4: POP P,A ;#2 Recover initial flags
STDIR5: TXNE A,RC%EMO ;#2 Exact match requested?
TDZA A,A ;#2 yes, no recognition
MOVSI A,(1B0) ;#2 no, allow recognition
JSYS 40 ;#2 STDIR
TXOA A,RC%NOM ;#2 +1; no match
TXO A,RC%AMB ;#2 +2; ambiguous
MOVEI C,(A) ;#2 TENEX directory number (18-bits)
POPJ P, ;#2
;.ACCES - connection to directory
.ACCES: SKIPN TOPS20 ;#2 Separate TOPS20/TENEX
JRST ACCES4 ;#2
MOVE A,[AC%CON+3] ;#2 flags,,count
MOVEI B,$ACCES ;#2 argument block
ACCES ;#2 (TOPS20 way)
ERJMP .GETER ;#2 Ret +1; error
JRST CPOPJ1 ;#2 Ret +2; okay
ACCES4: HRRZ A,$ACCES ;#2 flags,,dir#
MOVE B,$ACCES+1 ;#2 pointer to pswd
JSYS 44 ;#2 CNDIR (TENEX way)
JRST CPOPJ ;#2 Ret +1; error
JRST CPOPJ1 ;#2 Ret +2; okay
;.GTJFN - special GTJFN, strip off structure if TENEX
.GTJFN: SKIPE TOPS20 ;#2 Separate TOPS20/TENEX
JRST GTJFN8 ;#2
TLC B,-1 ;#2 Make sure "pointer" to string
TLCN B,-1 ;#2 is a legitimate byte pointer
HRLI B,440700 ;#2
PUSH P,B ;#2 Save ptr for later
PUSH P,C ;#2
ILDB C,B ;#2 Look over string
CAIE C,":" ;#2 until structure (device) punctuation
JUMPN C,.-2 ;#2 or end of string
SKIPN C ;#2 If structure not found
MOVE B,-1(P) ;#2 use entire string
POP P,C ;#2
POP P,0(P) ;#2
GTJFN8: GTJFN ;#2
JRST CPOPJ ;#2 Ret +1; error
JRST CPOPJ1 ;#2 Ret +2; okay
;.VACCT - verify account for given user
.VACCT: SKIPN TOPS20 ;#2 Separate TOPS20/TENEX
JRST VACCT4 ;#2
JSYS 566 ;#2 VACCT (TOPS20 way)
ERJMP CPOPJ ;#2 Ret +1; error
JRST CPOPJ1 ;#2 Ret +2; okay
VACCT4: JSYS 330 ;#2 VACCT (TENEX way)
JRST CPOPJ ;#2 Ret +1; error
JRST CPOPJ1 ;#2 Ret +2; okay
.GETER: PUSH P,B ;#2 For now, just TOPS20
MOVEI A,.FHSLF ;#2
GETER ;#2
MOVEI A,(B) ;#2
POP P,B ;#2
POPJ P, ;#2
;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 (XRCP,0) ;#7
M1 (XRSQ,0) ;#7
M1 (XSEN,0) ;#6
M1 (XSEM,0) ;#6
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
PUSHJ P,.SOUT ;#8
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
PUSHJ P,.RCUSR ;#2 See if user exists
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: MOVE A,[440700,,$ACCT+1] ; BACK HERE FROM ANONYMOUS
MOVE B,USERNM ;SEE IF USER HAS A DEFAULT ACCOUNT
SKIPN TOPS20 ;#2 TOPS20 does not yet support this
JSYS 331 ;#2 GDACC (TENEX way)
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 /SYSTEM:ANONYMOUS.USERFILE/] ;#2
SKIPN TOPS20 ;#2
HRROI B,[ASCIZ /<SYSTEM>ANONYMOUS.USERFILE/] ;#2
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: SKIPN TOPS20 ;#2
JRST PASS11 ;#2
MOVEI A,.SFNVT ;ARE LOGINS ON NVT'S ALLOWED?
TMON ; ..
JUMPE B,NVTNLI ;IF NOT, DON'T ALLOW FTP SERVICE EITHER
PASS11: MOVE A,USERNM ;#2 USER NUMBER
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 ;COMPOSE A PRETTY LOGIN MESSAGE
HRROI B,[ASCIZ /230 User /]
PUSHJ P,.SOUT ;#8
MOVE B,USERNM ;NAME STRING
DIRST
JFCL ;#2 can't fail
HRROI B,[ASCIZ / logged in at /]
PUSHJ P,.SOUT ;#8
SETO B,0
MOVSI C,200221 ;FORMAT OF DATE/TIME
ODTIM
HRROI B,[ASCIZ /, job /]
PUSHJ P,.SOUT ;#8
HRRZ B,GJINF3 ;JOB NUMBER
MOVEI C,12
NOUT
0
MOVEM A,REPLYP ;MESSAGE POINTER SO FAR.
HRROI B,CRLFM ;END OF LINE
PUSHJ P,.SOUT ;#8
HRROI A,REPLYM ;TYPE THE HERALD
PSOUT ; ..
MOVE A,[POINT 7,IPCDAT] ;#8 AND TELL CONTROLLER
HRROI B,[ASCIZ /FTP SERVER: /]
PUSHJ P,.SOUT ;#8
MOVE B,[100700,,REPLYM] ;AFTER THE 230
PUSHJ P,.SOUT ;#8
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
PUSHJ P,.ACCES ;#2 Attempt the requested access
JRST CWDER ;#13 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 /./
CWDER: HRROI B,[ASCIZ /330 Default name accepted, send password to connect to it./] ;#13
CAIE A,ACESX3 ;#13 If the error indicates the need for
CAIN A,CNDIX1 ;#13 or a correct password,
JRST RPCRLP ;#13 use this msg.
PUSH P,A ;#13 Otherwise compose a msg with
PUSHJ P,ADDREP ;#13 the system error string..
ASCIZ \431 CWD/PASS failed unexpectedly, \ ;#13
POP P,B ;#13
HRLI B,.FHSLF ;#13
ERSTR ;#13
JFCL ;#13
SKIPA ;#13
MOVEM A,REPLYP ;#13
JRST CRLFRP ;#13
.ORG ; BACK TO LOW SEGMENT
;ACCOUNT COMMAND
ZACCT: SKIPN USERNM ;#2 Insure proper sequence of user/pass/acct
JRST ACCT06 ;#2 isn't
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
PUSHJ P,.VACCT ;#2 Is it ok?
JRST ACCTNG ;#2 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./
ACCT06: JSP B,RPCRLP ;#2
ASCIZ /431 User name and password first, please./ ;#2
;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,100001 ;#9 NO, GET IT
HRROI B,[ASCIZ /SYS:UDDT.EXE/]
SKIPN TOPS20 ;#2
HRROI B,[ASCIZ /<SUBSYS>UDDT.SAV/] ;#2
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: GJINF ;#10 Get job info
JUMPL D,NOCLSD ;#10 If detached, simply logout
movei a,101 ;wait for end of output
dobe ; ..
DTACH ;GET OFF THE TTY
HANGU1: JUMPL D,NOclsD ;#10 NOT IF DETACHED
move a,[point 7,gtjstr] ;#8 this sequence closes the nvt
hrroi b,[asciz /tty/]
pushj p,.sout ;#8 build a string for the tty name
movei b,(d)
movei c,10 ;octal tty number
nout
jfcl
movei b,":" ;#8 terminating colon
idpb b,a ;#8
setz b, ;#8
idpb b,a ;#8
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
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
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,PI1AC+17 ;#10 STASH AC'S
MOVEI 17,PI1AC ;#10 JUST FOR SYMMETRY
BLT 17,PI1AC+16 ;#10
MOVE P,L1PDP ;#10 SET UP STACK
GJINF ;#10 Get current info about job
DTACH ;#10 Detach now! (wait for nothing)
RESET ;KILL EVERYTHING. (SHOULD DELETE FILE?)
JRST HANGU1 ;#10 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
;#7 Following code is for handling XRSQ/XRCP mail transfers..
;#7 Supports only "XRCP T" mode
;#7 XRSQ command - query and select XRCP mode
ZXRSQ: SETZM XRCPTX ;#7 Always reset text storage
CLOSE LCLJFN ;#7 ..
ILDB B,SBP ;#7 Get single char argument
JUMPE B,XRSQN ;#7 No arg is okay
CAIN B,"?" ;#7 Wants our preference?
JRST XRSQQ ;#7
TRZ B,40 ;#7 insure uppercase
CAIN B,"R" ;#7 Wants RCPT first?
JRST XRSQR ;#7 (lose)
CAIN B,"T" ;#7 Wants TEXT first?
JRST XRSQT ;#7 (win)
JSP B,RPCRLP ;#7 Unknown arg
ASCIZ /502 No such mode./ ;#7
XRSQQ: JSP B,RPCRLP ;#7
ASCIZ /215 T Text-first, please./ ;#7
XRSQN: SETZM XRCPSC ;#7 Clear setting to default scheme
JSP B,RPCRLP ;#7
ASCIZ /200 Resetting to no XRCP mode selected./ ;#7
XRSQR: JSP B,RPCRLP ;#7
ASCIZ /501 Text-first is the only mode supported./ ;#7
XRSQT: SETOM XRCPSC ;#7 Set -1 for "T" scheme
JSP B,RPCRLP ;#7
ASCIZ /200 Text first mode selected./ ;#7
;#7 XRCP command - specify addressee for mail already stored via MAIL/MLFL
;#7 with no argument; otherwise like MAIL in response/behavior
ZXRCP: SKIPL XRCPSC ;#7 Specified XRCP scheme?
JRST XRCPL1 ;#7 no, error
SKIPLE XRCPTX ;#7 Assume T scheme; do we have msg text?
SKIPG LCLJFN ;#7 Claim to, have real JFN?
JRST XRCPL2 ;#7 negative, lose
TRO F,R.XRCP ;#7 Flag XRCP command (not MAIL)
JRST MAIL0X ;#7 Enter normal mail code
XRCPL1: JSP B,RPCRLP ;#7
ASCIZ /507 No scheme specified yet. Use XRSQ./ ;#7
XRCPL2: JSP B,RPCRLP ;#7
ASCIZ /430 No mail text sent yet./ ;#7
;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 ; ..
CLOSE LCLJFN ;IN CASE ABORTED OUT OF MAIL
SETZM XRCPTX ;#7 Always reset text storage
TRZ F,R.XRCP ;#7 Flag MAIL command (not XRCP)
MAIL0X: TLZ F,L.MFWD ;#7 ASSUME NOT FORWARDING
SKIPLE NOMAIL ;#12 Is mail delievery allowed?
JRST MAILX7 ;#12 no, call everyone busy!
PUSHJ P,SST ;SKIP OVER TO NAME
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
MOVE A,[POINT 7,MLUNST] ;#8
MOVEI D,^D39 ;#8
PUSHJ P,.SOUTC ;#8
SKIPN MLUNST ;THERE WAS A NAME, WASNT THERE?
JRST [ TRNN F,R.XRCP ;#7 No, Lose if XRCP command
SKIPN XRCPSC ;#7 or if no XRCP scheme specified
JRST MAILX4 ;#7
SETOM XRCPTX ;#7 Okay, flag storing text
JRST MAIL0A] ;#7 go make temp file for it.
;#3 We use RCDIR in place of RCUSR because we want to be able
;#3 to send mail to files-only directories!
MOVE A,[POINT 7,MLFWST] ;#2 Compose filename here
HRROI B,[ASCIZ /PS:</] ;STICK IN USER NAME
PUSHJ P,.SOUT ;#8
HRROI B,MLUNST ;NAME FROM COMMAND
PUSHJ P,.SOUT ;#8
HRROI B,[ASCIZ />/] ;#3
PUSHJ P,.SOUT ;#8
MOVE D,A ;#3 save pointer for filename
MOVX A,RC%EMO ;EXACT MATCH ONLY
HRROI B,MLFWST ;#2 OK, GET DIRECTORY NUMBER
PUSHJ P,.RCDIR ;#3 ;#2 See if user exists
TXNE A,<RC%NOM!RC%AMB> ;DOES IT EXIST
JRST MLFWQ ;#3 no
MOVEM C,MLUSR ;SAVE THE DIRECTORY NUMBER
SKIPGE B,NOMAIL ;#12 See if this dir exempted from mail delivery..
CAME C,0(B) ;#12
AOBJN B,.-1 ;#12
JUMPL B,MAILX4 ;#12 If number found in table, yes
MOVE A,D ;#3
HRROI B,MAILFN ;#2
PUSHJ P,.SOUT ;#8
MOVSI A,101001 ;SEE IF MAILBOX EXISTS
HRROI B,MLFWST ;#2
PUSHJ P,.GTJFN ;#2
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
RLJFN ;RELEASE MAILBOX JFN
JFCL
TLNN C,(1B1)
JRST MLFWQ ;#3
PUSHJ P,TIMEOK ;UPDATE KILL TIME
MAIL0A: TRNE F,R.XRCP ;#7 If XRCP command,
JRST MAIL2A ;#7 then already have temp file, copy it.
MOVE A,[POINT 7,GTJSTR] ;#8 Build a name for temp file for mail
HRROI B,[ASCIZ /PS:<SYSTEM>--MAIL--./]
PUSHJ P,.SOUT ;#8
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.
PUSHJ P,.SOUT ;#8
MAIL01: MOVSI A,411001 ;GTJFN SHORT, STRING, OUT, TEMP, IG DEL.
HRROI B,GTJSTR ; ..
PUSHJ P,.GTJFN ;#2
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: ARPANET host /] ;#4
MOVEI C,0
SOUT
MOVE B,FHSTN ;#1 NOW PUT A TIME-STAMP ON. FIRST, HOST.
PUSHJ P,.CVHST ;#2 Get host name string
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..
SKIPE XRCPTX ;#7 If storing text for use by XRCP,
JRST MAIL3X ;#7 then just return positive ack to user.
; ..
; ..
MAIL2A: MOVEI X,5 ;TIMES TO TRY IF BUSY
MAIL2B: HRROI B,MLFWST ;#2 NOW GET A JFN FOR MAILBOX
MOVSI A,101001
TLNE F,L.MFWD ;FORWARDING?
TLZ A,101000 ;YES. ALLOW NEW FILE
PUSHJ P,.GTJFN ;#2
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)
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
; ..
; ..
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: MOVE A,[POINT 7,GTJSTR] ;#8 Where to build amusing string
HRROI B,[ASCIZ /[/]
PUSHJ P,.SOUT ;#8
MOVE B,FHSTN ;#1 Foreign host number
PUSHJ P,.CVHST ;#2 Get host name string
HRROI B,[ASCIZ /]/]
PUSHJ P,.SOUT ;#8
POP P,A
HRLI A,.SFLWR ; Set last writer of MAIL.TXT
HRROI B,GTJSTR ; To string we just built
SKIPE TOPS20 ;#2 TENEX doesn't have this (ERJMP is noop)
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./
MAIL3X: MOVEI A,1 ;#7 Set flag to 1,
MOVEM A,XRCPTX ;#7 meaning text exists and is ready
HRROI B,[ASCIZ /256 Mail stored successfully./] ;#7
TLNE F,L.MLFL ;#7
HRROI B,[ASCIZ /252 Mail stored successfully./] ;#7
JRST RPCRLP ;#7
;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>/]
PUSHJ P,.RCDIR ;#2
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
PUSHJ P,.GTJFN ;#2
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
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/]
SKIPN TOPS20 ;#2
HRROI B,[ASCIZ /<SUBSYS>MAILBOX.SAV/] ;#2
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: MOVE A,[POINT 7,MLFWST] ;#2 Copy over for a new file
HRROI B,[ASCIZ /[--UNSENT-MAIL--]./]
PUSHJ P,.SOUT ;#8 MAILER standard name
HRROI B,BLTADR+140
PUSHJ P,QVSTR ;#5
MOVEI B,"V"&37
IDPB B,A ;#8 Quote the at-sign
MOVEI B,"@"
IDPB B,A ;#8
HRROI B,BLTADR+150
PUSHJ P,QVSTR ;#5
HRROI B,[ASCIZ /;P770000/]
PUSHJ P,.SOUT ;#8
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
;;#11 MOVE A,0(P) ;AND MAILBOX.EXE JFN
;;#11 HRLI A,(1B0)
;;#11 CLOSF
;;#11 JFCL
POP P,A
;;#11 RLJFN
;;#11 JFCL
PUSHJ P,TIMEOK ;UPDATE KILL TIME
JRST MAIL0A ;NOW GET THE MAIL
QVSTR: TLC B,-1 ;#5 Insure (compose) byte pointer
TLCN B,-1 ;#5 to source string
HRLI B,440700 ;#5
MOVEI D,"V"&37 ;#5 Ctrl-V is the quote char
QVSTR1: ILDB C,B ;#5 Get character,
JUMPE C,QVSTR2 ;#5
CAIL C,"A" ;#5 uppercase letters,
CAILE C,"Z" ;#5
CAIN C,"$" ;#5 the dollar sign,
JRST QVSTR2 ;#5
CAIL C,"0" ;#5 all digits,
CAILE C,"9" ;#5
CAIN C,"-" ;#5 and the minus sign
JRST QVSTR2 ;#5 don't need to be quoted in
IDPB D,A ;#5 all other chars need preceeding ^V
QVSTR2: IDPB C,A ;#5 put character,
JUMPN C,QVSTR1 ;#5 continue until nul
ADD A,[7B5] ;#5 Backup dest ptr (overwrite nul)
POPJ P, ;#5
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
MOVE A,[POINT 7,MLFWST] ;#2 Ok to queue, make filename
HRROI B,[ASCIZ /[--UNSENT-MAIL--]./]
PUSHJ P,.SOUT ;#8
HRROI B,MLUNST
PUSHJ P,.SOUT ;#8
HRROI B,[ASCIZ /@;P770000/] ;#8
PUSHJ P,.SOUT ;#8
TLO F,L.MFWD
JRST MAIL2A
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: TRNE F,R.XRCP ;#7 If in XRCP command,
JRST MAIL5Z ;#7 don't zap stored text file!
SETZM XRCPTX ;#7 MAIL/MLFL always reset stored text!
SKIPGE A,LCLJFN
JRST MAIL5Z
MOVE A,LCLJFN ;CLOSE OUT THE TEMP FILE.
HRLI A,400000
CLOSF
JFCL
HRRZ A,LCLJFN
DELF
JFCL
CLOSE LCLJFN ;#7 moved here so XRCP can avoid it
CLOSE DATJFN ;#7 ..
MAIL5Z: HRROI B,(X) ;#7 Reply to correct AC
JRST RPCRLP ;#7
;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
MOVE A,[POINT 7,GTJSTR] ;#8 Build name for data connection
HRROI B,[ASCIZ /NET:2./]
PUSHJ P,.SOUT ;#8
MOVE B,FHSTN ;#1 FOREIGN HOST NUMBER
MOVEI C,10 ;OCTAL
NOUT
0
MOVEI B,"-"
IDPB B,A ;#8
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
PUSHJ P,.SOUT ;#8
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./
;#6 BEGIN addtion of several pages, XSEN implementation
; XSEN Command handling
ZXSEM: ; For time being, XSEM = XSEN.
ZXSEN: TLNE F,L.LOGI ; Can't do XSEN if logged in - wheelness lost.
JRST ORDERX
; Get argument (name to send to) and check it.
PUSHJ P,SST ; Push SBP to start of name.
MOVSI A,(RC%EMO) ; Using exact match,
MOVE B,SBP ; look at argument
PUSHJ P,.RCUSR ;#2 See if user exists
TLNE A,(RC%AMB!RC%NOM) ;#2 Was it any good?
JRST MAILX4 ; Foo, no such luser
MOVEM C,MLUSR ; Aha, save dir number!
; See if online now
PUSHJ P,ONLINE ; Scan tables etc.
JUMPE A,XSENX7 ; If not online, jump...
PUSHJ P,TTYACP ; Online, see if accepting links.
JRST XSENX8
; Online, collect message text into buffer
HRROI B,[ASCIZ /350 User online, send message ended by a line with only a "."
/]
PUSHJ P,SDUMPA ; Invite data over
PUSHJ P,MSGBEG ; Set up buffer for reception
PUSHJ P,MSGCOL ; Yum yum
; Text collection done, first try to stuff into SENDS.TXT file
; safely out of way, but don't barf if can't.
SETZM MLERRC ; Clear error indicator
MOVE A,SBP ; Get BP to name, which coincidentally is
PUSHJ P,WRTSND ; name of dir to write msg into!
MOVEM A,MLERRC ; If hit error, save code.
; OK, now again check for online TTY numbers just before sending.
PUSHJ P,ONLINE ; Return list of TTY's in A.
JUMPE A,XSENX7 ; Fooey, must have gotten wise to us.
MOVE D,A
; Send message to TTYs if possible.
SETZ T1, ; clear cnt of wins
XSEN4: MOVEI A,.TTDES
ADD A,(D) ; Get terminal designator
RFMOD ; Get mode word for terminal
TRNN B,TT%ALK ; Allowing links?
JRST XSEN5 ; Nope, assume refusing.
PUSHJ P,TIMEOK
DOBE ; Wait until can get at him.
ERJMP XSEN5 ; Hmm, something wrong? ignore it.
HRROI B,MSGBUF ; Can send, get pointer to message
MOVEI C,$MBFLN
SUB C,MSGCNT ; and cnt of chars in it
SOUT ; and send it!
AOS T1 ; Bump count of times sent.
XSEN5: AOBJN D,XSEN4
JUMPLE T1,XSENX9 ; Jump if didn't send to any.
; Successfully sent message, one last check...
SKIPE A,MLERRC ; was there an error in writing SENDS.TXT?
CAIE A,OPNX9 ; and was it "invalid simult access"?
JRST XSEN9 ; If not or no error, return straightaway.
; Hmm, try a little harder to get SENDS.TXT written.
MOVEI X,5 ; # times to try
XSEN7: MOVE A,SBP ; Luser name.
PUSHJ P,WRTSND ; Try again.
JRST [ CAIE A,OPNX9
JRST .+1 ; Leave loop if strange error,
SOJLE X,.+1 ; or if tried enough times.
MOVEI A,^D2000 ; Wait 2 sec each time
DISMS
JRST XSEN7]
; Return reply indicating success.
XSEN9: JSP B,RPCRLP
ASCIZ /256 Message sent successfully./
XSENX7: JSP B,RPCRLP
ASCIZ /453 User not online now./
XSENX8: JSP B,RPCRLP
ASCIZ /453 User is refusing./
XSENX9: JSP B,RPCRLP
ASCIZ /453 Message not sent - user now gone or refusing./
; Auxiliaries for XSEN - online checks etc.
; ONLINE - takes dir # in MLUSR, returns in A an AOBJN
; pointer to list of TTY's logged in under that directory.
ONLINE: MOVEI B,ONLNTB ; Init aobjn ptr to TTY table
MOVEM B,ONLNPT
HLLZ D,JOBRT ;#2 Init aobjn ptr for job scan
ONLIN4: SKIPN TOPS20 ;#2
JRST ONLIN1 ;#2
MOVEI A,(D) ; Job number
MOVE B,[-2,,T1] ; Where to stick goodies
MOVEI C,.JITNO ; Start with terminal number
GETJI ; T1 _ TTY; T2 _ User
JRST ONLIN8 ; No job there
ONLIN5: XOR T2,MLUSR ;#2 See if this is who we want
TRNE T2,-1 ;#2 (ignore structure info)
JRST ONLIN8 ; Nope
JUMPL T1,ONLIN8 ; Jump if job detached.
SKIPL B,ONLNPT ; Get aobjn ptr to TTY table
JRST ONLIN6
CAME T1,(B)
AOBJN B,.-1
JUMPL B,ONLIN8 ; Jump if TTY already in table.
ONLIN6: MOVEM T1,(B) ; Not found in table, store in 1st free slot
MOVSI A,-1
ADDM A,ONLNPT ; Add one to AOBJN count.
CAIL B,ONLNTB+$OLNTL ; If stuck this one into last slot,
JRST ONLIN9 ; time to return.
ONLIN8: AOBJN D,ONLIN4 ; search all of jobdir table.
ONLIN9: SKIPL A,ONLNPT ; Return AOBJN pointer
SETZ A, ; Or zero.
POPJ P,
ONLIN1: MOVE A,JOBRT ;#2 TENEX job scan..
HRLI A,(D) ;#2 First see if job exists,
GETAB ;#2 it does if runtime is positive
PUSHJ P,BOMB ;#2
JUMPL A,ONLIN8 ;#2
MOVE A,JOBTTY ;#2 Okay, now get the controlling terminal
HRLI A,(D) ;#2
GETAB ;#2
PUSHJ P,BOMB ;#2
HLRE T1,A ;#2
MOVE A,JOBDIR ;#2 and user number (login directory)
HRLI A,(D) ;#2
GETAB ;#2
PUSHJ P,BOMB ;#2
HRRZ T2,A ;#2 (ignore connected directory)
JRST ONLIN5 ;#2
; TTYACP - Takes AOBJN ptr to TTY list (as returned by ONLINE) in A,
; skips if at least one is accepting links. Fails if none
; are accepting links. Doesn't clobber A.
TTYACP: PUSH P,A
MOVE D,A
TTYAC4: MOVEI A,.TTDES
ADD A,(D) ; Get JFN for terminal descriptor
RFMOD ; Get mode word for terminal
TRNE B,TT%ALK ; Allowing links?
AOSA -1(P) ; Yes, skip out and do a skip return.
AOBJN D,TTYAC4 ; Hmm, if not check all TTY's on list.
POP P,A
POPJ P,
; MSGBEG - Set up initial string in message buffer.
MSGBEG: MOVE A,[440700,,MSGBUF]
HRROI B,[ASCIZ /TTY message from ARPAnet host /]
PUSHJ P,.SOUT ;#8
MOVE B,FHSTN ;#1 NOW PUT A TIME-STAMP ON. FIRST, HOST.
PUSHJ P,.CVHST ;#2 Get host name string
HRROI B,[ASCIZ /:
/]
PUSHJ P,.SOUT ;#8
MOVEM A,MSGBPT ; Store updated BP into buffer.
HRROI B,MSGBUF
PUSHJ P,PTRDIF ; Get BP pointer difference into C
SUBI C,$MBFLN ; Get -# chars left in buffer
MOVMM C,MSGCNT ; Store # chars left as count.
MOVEI A,1
MOVEM A,MSGLNS ; Start count of # lines.
POPJ P,
; MSGCOL - Collect message text over command connections.
; Gobbles into core until usual "." line seen.
MSGCOL: PUSHJ P,LINEIN ; Get a line of input
JRST [ TLNE F,L.LTL
JRST MAILX6
JRST MAILX8]
MOVE A,CMDIB ; If line was only a period
CAMN A,[ASCII /./]
POPJ P, ; then we are thru
MOVE A,MSGBPT ; Copy the line into our buffer..
HRROI B,CMDIB
MOVE D,MSGCNT
PUSHJ P,.SOUTC ;#8
JUMPE D,MAILX5 ; Complain if we run out of buffer
HRROI B,CRLFM ; Tack on end-of-line which was stripped off
PUSHJ P,.SOUTC ;#8
JUMPE D,MAILX5
MOVEM A,MSGBPT ; Save current pointer into msg
MOVEM D,MSGCNT ; and how much space is left
AOS MSGLNS ; Increment line cnt
PUSHJ P,TIMEOK ; Bletcherous crock
JRST MSGCOL ; continue
; PTRDIF - Takes BPs in A and B, leaves difference (# chars)
; in C. Think of it as A-B => C
; Won't work for indexed/indirected bp's.
PTRDIF: PUSH P,A
PUSH P,B
TLNE A,7077 ; Assume LH -1 if any of these bits set.
HRLI A,440700
TLNE B,7077 ; Ditto.
HRLI B,440700
MULI B,5 ; Get stuffs
ADD C,PTRD7P(B) ; and work magic to get canonical pointer
MULI A,5
ADD B,PTRD7P(A) ; Ditto for other bp.
SUBM B,C ; Put A-B in C.
POP P,B
POP P,A
POPJ P,
133500,,0 ; to handle -5 produced by 440700
BLOCK 4 ; never ref'd
PTRD7P: -54300,,5 ; Magic numbers...
-104300,,4
-134300,,3
-164300,,2
-214300,,1
; WRTSND - write out message buffer. A holds BP to directory name.
; Skips if successful. Error return gives err code in A.
; maybe later make more general.
WRTSND: MOVE D,A
MOVE A,[POINT 7,GTJSTR] ;#8 Compose filename here
HRROI B,[ASCIZ /PS:</]
PUSHJ P,.SOUT ;#8
MOVE B,D
PUSHJ P,.SOUT ;#8
HRROI B,[ASCIZ />SENDS.TXT.0;T/]
PUSHJ P,.SOUT ;#8
; Have filename to hunt for (or create), get JFN etc.
MOVSI A,(GJ%SHT) ; Short form is all.
HRROI B,GTJSTR
PUSHJ P,.GTJFN ;#2
POPJ P, ; Failed?? non-skip return, err code in A.
MOVE D,A ; Save JFN
MOVE B,[7B5+OF%APP] ; Open for appending
OPENF
JRST [ EXCH A,D ; Failed... perhaps simultaneous access.
RLJFN ; for now, just return.
JFCL
MOVE A,D ; return err code.
POPJ P,]
; Hurray, have it open - kick message out.
MOVEI A,(D)
HRROI B,MSGBUF ; Get pointer to message
MOVEI C,$MBFLN
SUB C,MSGCNT ; and cnt of chars in it
SOUT ; and send it!
CLOSF ; Close file (LH = 0)
JFCL
AOS (P) ; Win return.
POPJ P,
;#6 END addition of several pages, XSEN implementation
;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
SKIPN TOPS20 ;#2 TENEX doesn't support IPCF
POPJ P, ;#2
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
PUSHJ P,.RCDIR ;#2 See if it exists
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
PUSHJ P,.ACCES ;#2 Attempt the requested access
JRST XCWD2 ;#2 failed
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 ; ..
PUSH P,A ;#13 Save the error code
MOVEI A,400000 ;RESTORE CAPS
EPCAP
POP P,A ;#13
JRST CWDER ;#13 Let user know of failure
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.
TLNE A,740000 ;#1 Legal host number?
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./ ;#1
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 /]
PUSHJ P,.SOUT ;#8
HRRZ B,LCLJFN ;FILE NAME
MOVE C,[211110,,040001] ;FORMAT BITS
JFNS
HRROI B,[ASCIZ / started.
/]
PUSHJ P,.SOUT ;#8
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
JRST RETXX ;#14
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
SKIPN TOPS20 ;#2
MOVSI B,25 ;#2
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 /]
PUSHJ P,.SOUT ;#8
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.
/]
PUSHJ P,.SOUT ;#8
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 STOXX ;#14 SEND IT TO USER
STOERR: HRROI X,STOERM ;ERROR FRM NET
JRST STOXX ;#14
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
JRST STOXX ;#14
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
PUSHJ P,.SOUT ;#8
SKIPN JFNTXS ;A FILE NAME?
JRST DELXX1 ;NO
HRROI B,[ASCIZ / - file /]
PUSHJ P,.SOUT ;#8
HRROI B,JFNTXS
PUSHJ P,.SOUT ;#8
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
MOVEI D,<5*40>-1 ;#8
PUSHJ P,.SOUTC ;#8
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:2./] ;#8 local socket 2 for read connection
TLNE F,L.SEND ;#8
HRROI B,[ASCIZ /NET:3./] ;#8 local socket 3 for write connection
PUSHJ P,.SOUT ;#8 (job relative sockets)
;FALL THRU
;FALLS IN FROM ABOVE
PRED2B: 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?
TROA B,1 ;#1 yes, insure odd number
TRZ B,1 ;#1 no, insure even number
JRST .+1]
MOVEI C,10 ;SOCKET IN OCTAL
NOUT
PUSHJ P,BOMB
HRROI B,[ASCIZ /;T/] ;JOB-LOCAL SOCKET
PUSHJ P,.SOUT ;#8
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)
1,,DETINT ;26 DETACH INTERRUPT ;#10
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==.
PRMTBL: ['MAILFN'],,[XWD 10,MAILFN] ;#2 expect ASCIZ /MAIL.TXT.1/, or
;#2 ASCIZ /MESSAGE.TXT;1/
['NOMAIL'],,[XWD LCMDIB,CMDIB] ;#2 expect ASCIZ /list/, where 'list'
;#2 is dir name(s) separated by comma
0 ;#2
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
TOPS20: BLOCK 1 ;#2 Flag: 1=TOPS20, 0=TENEX
JOBRT: BLOCK 1 ;#2 SYSGT(JOBRT) table info
JOBDIR: BLOCK 1 ;#2 SYSGT(JOBDIR) table info
JOBTTY: BLOCK 1 ;#2 SYSGT(JOBTTY) table info
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
XRCPSC: BLOCK 1 ;#7 XRCP scheme: 0=none, -1=T, +1=R
XRCPTX: BLOCK 1 ;#7 XRCP saved-text flag: 0=none,
;#7 -1=collecting, +1=save (LCLJFN=temp file)
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
NOMAIL: ASCIZ/PS:<SYSTEM>/ ;#12 "No mail" directive:
;#12 =0 everyone may receive mail
;#12 >0 nobody may receive mail
;#12 <0 AOBJN ptr to table who can't
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
NCPBLK: BLOCK 20 ;#1 GTNCP info block
; =NCPBLK+.NCIDX ;#1 NCP connection index
FHSTN= NCPBLK+.NCFHS ;#1 foreign host
NETLSK=NCPBLK+.NCLSK ;#1 local socket
FORNS= NCPBLK+.NCFSK ;#1 foreign socket
; =NCPBLK+.NCFSM ;#1 state of connection
; =NCPBLK+.NCLNK ;#1 link
; =NCPBLK+.NCNVT ;#1 NVT, or -1 if none
; =NCPBLK+.NCSIZ ;#1 byte size of connection
; =NCPBLK+.NCMSG ;#1 msg allocation
; =NCPBLK+.NCBAL ;#1 bit allocation
; =NCPBLK+.NCDAL ;#1 desired allocation
; =NCPBLK+.NCBTC ;#1 bits transferred
; =NCPBLK+.NCBPB ;#1 bytes per buffer
; =NCPBLK+.NCCLK ;#1 time-out countdown
; =NCPBLK+.NCSTS ;#1 connection status
ONLNPT: BLOCK 1 ;#6 AOBJN ptr into ONLNTB table of TTYs
$OLNTL==10 ;#6 Max # of TTYs that XSEN can send to (arbitrary)
ONLNTB: BLOCK $OLNTL ;#6 Table of TTYs specific user is logged in on.
MSGBPT: BLOCK 1 ;#6 Byte pointer into MSGBUF
MSGLNS: BLOCK 1 ;#6 # lines of text in MSGBUF
MSGCNT: BLOCK 1 ;#6 # chars left in MSGBUF
MLERRC: BLOCK 1 ;#6 Error code returned by WRTSND, else zero.
CHKBLK: BLOCK 5 ;#6 For checking access to maybe login as anonymous
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
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
MAILFN: ASCIZ/MAIL.TXT.1/ ;#2 Mailbox name (i.e. MAIL.TXT.1)
MLFWST: BLOCK 50 ;#5 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
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
XSTDIR: BLOCK 11 ;#2 Extra space for .RCDIR/.RCUSR
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
MSGBUF: BLOCK 2000 ;#6 Room for collecting message text.
$MBFLN==2000*5 ;#6 Max # chars of room in MSGBUF.
IFN .&777,<PRINTX STORAGE NOT ON PAGE BOUNDARIES!!!>
END GO