TITLE 'MAGTAPE TCP SERVER' *++ * * -*-ASMH-*- * * PROGRAM TO ACCEPT CONNECTIONS FROM REMOTE CLIENTS AND WRITE THEIR * DATA ON AN MTS MAGTAPE DRIVE. THE PROBLEM WITH DOING THIS USING $FTP * (ASIDE FROM BLOCKING PROBLEMS, $FTP ALWAYS WRITES LITTLE 256-BYTE * RECORDS IN "TYPE I" MODE) IS THAT FTP OPENS A SEPARATE CONNECTION FOR * TRANSFERRING EACH INDIVIDUAL FILE. MTS'S TCP INTERFACE STICKS THE * USER WITH WAITING FOR OUR "FIN" TO BE ACKNOWLEDGED BY THE REMOTE * SYSTEM BEFORE IT WILL UNBLOCK THE USER JOB, AND THERE SEEMS TO BE * ADD'L DELAY BEYOND THAT TOO. SO THE SYSTEM SPENDS MOST OF ITS TIME * WAITING FOR CLOSES, AND IT TAKES HOURS TO TRANSFER A FEW HUNDRED * FILES, EVEN IF THEY ALL FIT ON ONE TAPE. * * SO THE IDEA WITH THIS SIMPLE PROGRAM IS, ALL MAGTAPE I/O IS DONE * THROUGH A SINGLE TCP CONNECTION FROM THE REMOTE SYSTEM. EACH COMMAND * FROM THE REMOTE SYSTEM STARTS WITH A 16-BIT HALFWORD (IBM 370 BYTE * ORDER, MSB FIRST) AS FOLLOWS: * * 0 WRITE TAPE MARK * 1 READ A RECORD * 2 CLOSE CONNECTION * 3 REWIND * 4 BACKWARD SPACE FILE * 5 BACKWARD SPACE RECORD * 6 SPACE TO LEOT (BETWEEN THE TWO TAPE MARKS) * 7 FORWARD SPACE FILE * 8 FORWARD SPACE RECORD * 9-17 UNDEFINED * >=18 WRITE A RECORD, COMMAND CODE IS LENGTH * * (RECORD LENGTHS .LT.18 ARE PROHIBITED BY INDUSTRY STANDARD HARDWARE.) * * ALL COMMANDS RETURN A ONE-BYTE STATUS CODE, WHICH IS X'00' FOR * SUCCESS AND X'FF' FOR FAILURE. IN THE CASE OF COMMAND 2 (READ A * * RECORD), THIS CODE (IF ZERO) IS FOLLOWED BY A 16-BIT LENGTH (MSB * FIRST) AND A DATA RECORD. IF THE LENGTH IS X'0000' THEN A TAPE MARK * WAS READ AND NO DATA FOLLOW. * * NOTE THAT THE FORWARD/BACKWARD SPACE COMMANDS DON'T TAKE AN ARGUMENT, * IF YOU WANT TO MOVE BY MORE THAN ONE RECORD OR FILE YOU'LL HAVE TO * SEND MULTIPLE COMMANDS. ALSO LIMITING READ RECORD SIZE IS THE * CLIENT'S PROBLEM, YOU'LL HAVE TO READ THE LENGTH FIRST AND DECIDE HOW * MUCH DATA TO KEEP AND HOW MUCH TO DISCARD, IF YOU CAN'T HANDLE * ALLOCATING A 32767-BYTE BUFFER (WHICH IS THE MOST THAT MTS WILL EVER * READ IN A RECORD). * * TAPE SHOULD BE ATTACHED TO UNIT 1. * * AUG 14/93 JMBW CREATED (WRITE ONLY). * MAR 12/95 JMBW READ, $CONTROL, RETURN CODE. * *-- SPACE * TT EQU 0 ;DEFINE REGISTERS A EQU 1 B EQU 2 C EQU 3 D EQU 4 E EQU 5 F EQU 6 * MACRO &LAB JSYS &DEST,&ARGS,&ERR ;JUMP TO SYSTEM &LAB L 15,=V(&DEST) AIF ('&ARGS' EQ '').NOARGS LA 1,&ARGS .NOARGS BASR 14,15 AIF ('&ERR' EQ '').NOPUNT LTR 15,15 BNZ &ERR .NOPUNT MEND * * $MOUNT STRING/ARG LIST * IF FOO IS "MOUNT" ARG LIST, * RFOO IS "RELEASE" ARG LIST, * AND PFOO IS PSEUDO DEVICE NAME (FOR "GETFD") MACRO &LAB MOU &STR LCLC &S &S SETC '&STR'(2,K'&STR-2) &LAB DC A(ONE,C&LAB,L&LAB),X'80',AL3(MOPT) C&LAB DC C'&S ' ;blank for GETFD L&LAB DC Y(L'C&LAB-1) ;not included in count R&LAB DC A(P&LAB,M&LAB,RELFLG) ;RELEASE arg list P&LAB EQU C&LAB+4 ;PDN M&LAB DC A(L'C&LAB-5) ;PDN length MEND * * $CONTROL STRING/ARG LIST MACRO &LAB CONT &STR,&FDUB LCLA &LEN &LEN SETA K'&STR-2 &LAB DC A(*+18,*+12,&FDUB,CTAREA),Y(&LEN),C&STR MEND * * ENTRY POINT * TAPESRV CSECT ENTER 12,SA=REGS * ALLOCATE A TCP PORT JSYS MOUNT,NET,PUNT ;MOUNT NET CONNECTION JSYS GETFD,PNET ;GET FDUB PTR ST TT,NETFD ;SAVE IT JSYS CONTROL,ACCEPT,PUNT ;LISTEN MVC BUF(14),=C'SENSE "SOCKET"' ;COPY SENSE CMD * DISPLAY PORT # SO THEY CAN %FLIP AND CONNECT FROM UNIX SIDE JSYS CONTROL,=A(BUF,LENSKT,NETFD,0),PUNT ;GET SOCK PARMS XR A,A ;INIT TO 0 ICM A,3,BUF ;GET LOCAL PORT # LA B,BUF+100 ;PT OFF INTO BUFFER LR D,B ;SAVE BAL 10,DECOUT ;CONVERT # S B,=F'11' ;BACK UP FOR TEXT MVC 0(11,B),=C' TCP PORT #' ;INSERT IT ST B,SPLIST ;SET ADDR SR D,B ;FIND LENGTH STH D,LEN JSYS SPRINT,SPLIST * LISTEN ON TCP PORT JSYS CONTROL,WAIT,PUNT ;WAIT FOR CALL * * GET NEXT CMD * LOOP LA C,2 ;GET 2 BYTES BAL 10,RDATA B PUNT XR C,C ;CLEAR OUT LH OF C ICM C,3,BUF ;GET HALFWORD COMMAND OR RECLEN LR A,C ;MAKE A COPY SLL A,2 ;*4 CL C,=F'18' ;CMD.LT.18? BLT DISPAT(A) ;DISPATCH IF SO *+ * * WRITE RECORD * *- STH C,RECL ;SAVE BAL 10,RDATA ;AND READ THE RECORD B PUNT JSYS WRITE,TIO,LOSE ;WRITE TO UNIT 1 B WIN * DISPAT B TMARK ;0 WRITE TAPE MARK B RDREC ;1 READ A RECORD B CLSCX ;2 CLOSE CONNECTION B REWND ;3 REWIND TO BOT B BKSPF ;4 BACKSPACE FILE B BKSPR ;5 BACKSPACE RECORD B SPEOT ;6 SPACE TO LEOT B FWSPF ;7 FORWARD SPACE FILE B FWSPR ;8 FORWARD SPACE RECORD B LOSE ;9 UNDEFINED B LOSE ;10 . B LOSE ;11 . B LOSE ;12 . B LOSE ;13 . B LOSE ;14 . B LOSE ;15 . B LOSE ;16 . B LOSE ;17 . * EJECT *+ * * WRITE TAPE MARK * *- TMARK JSYS CONTROL,WTM,LOSE ;WRITE TAPE MARK B WIN *+ * * READ A RECORD. * *- RDREC JSYS READ,TIO,RDREC1 ;READ FROM TAPE BAL 10,SENDRC ;SEND SUCCESSFUL RC JSYS WRITE,=A(RECL,H2,ZERO,DUMMY,NETFD),PUNT ;WRITE LEN JSYS WRITE,=A(BUF,RECL,ZERO,DUMMY,NETFD),PUNT ;WRITE REC B LOOP RDREC1 C 15,EOF ;EOF? BNE LOSE ;NO, PUNT BAL 10,SENDRC ;SEND SUCCESSFUL RC JSYS WRITE,=A(ZERO,H2,ZERO,DUMMY,NETFD),PUNT ;WRITE LEN=0 B LOOP *+ * * CLOSE CONNECTION. * *- CLSCX BAL 10,SENDRC ;SEND HAPPY RC L TT,NETFD ;GET NET FDUB PTR JSYS FREEFD JSYS RELEASE,RNET ;$RELEASE *NET* EXIT *+ * * REWIND TAPE TO BOT. * *- REWND JSYS CONTROL,REW,LOSE ;REWIND B WIN *+ * * BACKSPACE FILE. * *- BKSPF JSYS CONTROL,BSF,LOSE ;BACKSPACE ONE FILE B WIN *+ * * BACKSPACE RECORD. * *- BKSPR JSYS CONTROL,BSR,LOSE ;BACKSPACE ONE RECORD B WIN *+ * * SPACE TO LOGICAL END OF TAPE (BETWEEN THE TWO TAPE MARKS). * * $CONTROL *MT* POSN=*EOT* WORKS ONLY FOR LABELED TAPES, SO WE'LL HAVE * TO TOOL IT OUT. * *- SPEOT JSYS CONTROL,BSR ;BACK UP ONE IN CASE ALREADY THERE SPEOT1 JSYS READ,TIO,SPEOT2 ;READ A RECORD (AND DROP IT) B SPEOT1 ;LOOP SPEOT2 C 15,EOF ;EOF RIGHT? BNE LOSE ;ERROR IF NOT JSYS READ,TIO ;TRY TO READ ANOTHER REC LTR 15,15 ;DOUBLE EOF? BZ SPEOT1 ;NO, KEEP GOING C 15,EOF ;MAKE SURE IT'S REALLY EOF BNE LOSE ;ERROR IF NOT JSYS CONTROL,BSR,LOSE ;YES, BACK UP IN BETWEEN TAPE MARKS B WIN ;AND WIN *+ * * FORWARD SPACE FILE. * *- FWSPF JSYS CONTROL,FSF,LOSE ;SPACE B WIN *+ * * FORWARD SPACE RECORD. * *- FWSPR JSYS CONTROL,FSR,LOSE ;SPACE B WIN * PUNT JSYS SERCOM,=A(NIOERR,NIOLEN,ZERO,DUMMY) EXIT * WIN BAL 10,SENDRC ;SEND SUCCESSFUL RC B LOOP * LOSE MVI BUF,X'FF' ;FAILURE BAL 10,SENDRC1 ;SEND IT B LOOP *+ * * SEND (SUCCESSFUL) RETURN CODE TO CLIENT. * *- SENDRC MVI RCODE,X'00' ;RC=0 (SUCCESS) SENDRC1 JSYS WRITE,=A(RCODE,H1,ZERO,DUMMY,NETFD),PUNT ;SEND BR 10 *+ * * READ A BLOCK OF DATA FROM THE SOCKET. * * THE SOCKET IS A STREAM SO THE MTS RECORD-ORIENTED FILE HANDLING MAY * HACK IT UP AT STRANGE BOUNDARIES, WE JUST READ REPEATEDLY UNTIL WE * GET ENOUGH TO BUILD THE WHOLE BLOCK. EXCESS IS SAVED FOR NEXT TIME. * * C COUNT OF CHARS TO READ * *- RDATA LA B,BUF ;POINT AT OUTPUT BUF RDATA1 LH E,INCTR ;GET # BYTES IN INPUT BUF LTR E,E ;ANYTHING? BZ RDATA5 ;NO, GET SOMETHING L D,INPTR ;YES, GET ADDR LR F,C ;GET # BYTES WE WANT CLR F,E ;ARE THAT MANY AVAILABLE? BLE RDATA2 LR F,E ;NO, ONLY ASK FOR WHAT'S THERE RDATA2 SR C,F ;UPDATE COUNTS SR E,F LA TT,0(D,F) ;GET NEW PTR ST TT,INPTR STH E,INCTR ;UPDATE CTR TOO * COPY F BYTES FROM (D) TO (B) RDATA3 CL F,=F'256' ;.LE.256? BLE RDATA4 ;NO MVC 0(256,B),0(D) ;YES, COPY IT LA B,256(B) ;UPDATE PTRS LA D,256(D) S F,=F'256' ;AND COUNT B RDATA3 ;TRY AGAIN RDATA4 BCTR F,0 ;F-1 FOR MVC EX F,RDMVC ;COPY WHAT'S LEFT LA B,1(B,F) ;UPDATE OUTPUT PTR LTR C,C ;DONE? BNZ RDATA1 ;KEEP TRYING IF NOT B 4(10) ;SKIP RETURN RDATA5 JSYS READ,=A(HBUF,LEN,ZERO,DUMMY,NETFD) ;READ MORE LTR 15,15 ;ERROR? BNZR 10 ;RETURN W/O SKIPPING IF SO L TT,=A(HBUF) ;REINIT PTR ST TT,INPTR ;UPDATE CTR LH TT,LEN ;AND CTR STH TT,INCTR B RDATA1 ;KEEP GOING RDMVC MVC 0(0,B),0(D) ;COPY LAST CHUNK *+ * * CONVERT A NUMBER TO DECIMAL. * * A/ NUMBER * B/ BUF (PREDECREMENT) * 10/ LINK * *- DECOUT LA C,10 ;RADIX DOUT1 XR TT,TT ;ZERO-EXTEND DR TT,C ;/10 BCTR B,0 ;B-1 STC TT,0(B) ;SAVE DIGIT VALUE OI 0(B),C'0' ;CONVERT TO EBC-DICK LTR A,A ;ANYTHING LEFT? BNZ DOUT1 BR 10 * EJECT LTORG * ZERO DC F'0' TAPE DS 0F ;TAPE UNIT # ONE DS 0F ;FULLWORD 1 DC H'0' ;(HIGH HALFWORD=0) H1 DC H'1' ;HALFWORD "1" H2 DC H'2' ;HALFWORD "2" EOF DC F'4' ;RC FROM "READ" ON EOF @MAXLEN DC XL4'08000000' MOPT DC XL4'E800' ;NO MSGS OR PROMPTS RELFLG DC XL4'10' ;NO MSGS NET MOU 'TCP *NET*' LENSKT DC H'14' ;LENGTH OF 'SENSE "SOCKET"' CMD NIOERR DC C' ?TCP I/O ERROR' NIOLEN DC Y(L'NIOERR) ACCEPT CONT 'ACCEPT',NETFD ;$CONTROL *NET* ACCEPT WAIT CONT 'WAIT_FOR_CALL',NETFD ;$CONTROL *NET* WAIT_FOR_CALL * TIO DC A(BUF,RECL,ZERO,DUMMY,TAPE) ;TAPE I/O ARG LIST * WTM CONT 'WTM',TAPE ;$CONTROL *MT* WTM [1] REW CONT 'REW',TAPE ;$CONTROL *MT* REW FSR CONT 'FSR',TAPE ;$CONTROL *MT* FSR [1] BSR CONT 'BSR',TAPE ;$CONTROL *MT* BSR [1] FSF CONT 'FSF',TAPE ;$CONTROL *MT* FSF [1] BSF CONT 'BSF',TAPE ;$CONTROL *MT* BSF [1] * SPLIST DC A(0,LEN,ZERO,DUMMY) INCTR DC H'0' ;COUNT OF BYTES IN HBUF * DUMMY DS F NETFD DS F ;NET FDUB PTR REGS DS 18F ;R13 SAVE AREA LEN DS H ;LENGTH FROM I/O CALLS RECL DS H ;LENGTH OF CURR REC INPTR DS F ;PTR INTO HBUF CTAREA DS 27F ;AREA FOR CONTROL CALLS RCODE DS X ;RETURN CODE TO CLIENT * DS 0H ;HALFWORD ALIGNED BUF DS 32767X ;GENERAL-PURPOSE BUFFER * DS 0H ;HALFWORD ALIGNED HBUF DS 32767X ;HOLDING BUF FOR TCP INPUT END TAPESRV