.title k11atr process attribute packets .ident /1.0.01/ ; 18-Apr-84 11:20:59 Brian Nelson ; ; Copyright (C) 1984 Change Software, Inc. ; ; ; Process attribute packets for RSTS/E and RSX11M/M+ ; ; This module is intended to be placed into an overlay ; which MUST be the 'ERROR' cotree as the server, which ; is overlayed in the 'UTILTY' cotree can indirectly ; call the module through the packet control routines. ; This module will also be rather RMS11 dependent. ; ; ; Get the Kermi-11 common macro definition INCLUDE file .include /IN:K11MAC.MAC/ .psect $pdata watt: .word sn.sys ,sn.typ ,sn.fab ,sn.pr0 ,sn.pr1 ,sn.len ,0 attrty: .byte 41 ,42 ,43 ,44 ,45 ,46 ,47 .byte 50 ,51 ,52 ,53 ,54 ,55 ,56 .byte 57 ,60 .byte 0 .even attrds: .word at.$$ .word at.len ,at.typ ,at.cre ,at.id ,at.bil ,at.area,at.pas .word at.bsiz ,at.acc ,at.enc ,at.dis ,at.pr0 ,at.pr1 ,at.sys .word at.for ,at.fab badpak: .asciz /Unknown attribute packet type / .even .psect $code .sbttl return the next attribute packet to send ; W $ A T T R ; ; input: @r5 filename address ; 2(r5) lun it's using ; 4(r5) output packet address ; ; output: r0 rms error code, else zero ; r1 > 0 the packet length, also come back for more later ; r1 = 0 no more packets or else receiver can't handle them w$attr::save ; save registers that we may use here bitb #capa.a ,conpar+p.capas ; the other system handle 'A' packets? beq 90$ ; no, exit with 'eof' 10$: mov 4(r5) ,r4 ; point to the packet mov atrctx ,r0 ; now dispatch on what to send next asl r0 ; simple to do tst watt(r0) ; all done ? beq 90$ ; yes, just exit then jsr pc ,@watt(r0) ; and do it inc atrctx ; next time, do the next one in the list tst r0 ; was it possible to do this attr? bne 10$ ; no, try the next one then strlen 4(r5) ; get the length and return it mov r0 ,r1 ; and say that this packet is for real clr r0 ; exit without error br 100$ ; bye 90$: clr r0 ; all done, no more attributes to clr r1 ; send over clr atrctx ; init for the next file we send 100$: unsave ; pop these and exit return ; bye .sbttl dispatch routines for sending 'a' packets sn.sys: call getsys ; get the system type first scan r0 ,#200$ ; find out what we are tst r0 ; did it work ? beq 110$ ; no movb #'. ,(r4)+ ; sys id attr packet movb #'D&137 ,(r4)+ ; return the vendor code (DEC) movb 210$(r0),(r4)+ ; and the system type clrb @r4 ; .asciz clr r0 ; say it worked return ; bye 110$: mov sp ,r0 ; it failed return 200$: .byte sy$11m ,sy$ias ,sy$rsts,sy$mpl ,sy$rt ,sy$pos ,0 210$: .byte 0 .byte '8 ,'9 ,'A&137 ,'8 ,'B&137 ,'C&137 ,0 .even .sbttl send a copy of the ifab over ; The routine 'GETATR' takes the directory (or file header) information ; regarding the file format from the IFAB allocated to the FAB for the ; file currently being sent. This data is converted to octal strings and ; then sent over as an ATTRIBUTE packet with a type of '0', which is the ; type reserved for system specific data. ; The receiver KERMIT should ALWAYS get the SYSTEM and EXECUTIVE type ; attribute packet first so it can decide whether or not it wants to use ; the data being sent. ; ; For instance, the file A.A would have a packet sent over as in below ; ; Name .Typ Size Prot Access Date Time Clu RTS Pos ;A .A 1 < 60> 01-May-84 01-May-84 10:17 AM 4 ...RSX 3493 ; RF:VAR=132 FO:SEQ USED:1:98 RECSI:46 CC:IMP ; ; ; ;SPACK - Length 78 Type A Paknum 3 ;0001002 000056 000000 000001 000000 000001 000142 000000 000204 000000 000000 sn.fab: calls getatr ,<2(r5),#at$fab>; get the ifab stuff now tst r0 ; but did it work? bmi 100$ ; no, it crapped out movb #'0 ,(r4)+ ; return sys type attr code mov r4 ,r0 ; fill it with spaces first mov #13*7 ,r1 ; simple 5$: movb #40 ,(r0)+ ; sob r1 ,5$ ; next mov #at$fab ,r2 ; where we store such things mov #13 ,r0 ; number of words to send 10$: calls l$otoa , ; do it add #7 ,r4 ; skip over it sob r0 ,10$ ; next clr r0 ; say that it worked clrb @r4 ; .asciz 100$: return .sbttl send file type (ascii,binary), protection and size sn.typ: movb #42 ,(r4)+ ; attribute type movb #'A&137 ,@r4 ; assume ascii cmpb image ,#binary ; already decided that it's binary? bne 10$ ; no movb #'I&137 ,@r4 ; yes, say it's image mode today 10$: clrb 1(r4) ; insure .asciz clr r0 ; flag success and exit return ; bye sn.pr0: sn.pr1: mov #-1 ,r0 return sn.len: calls getsiz ,<2(r5)> ; get the size of the file please tst r0 ; did this work ? bne 100$ ; no inc r1 ; try to accomodate rounding asr r1 ; in 1024 blocks, not 512 bic #100000 ,r1 ; insure no sign bits now movb #41 ,(r4)+ ; attribute type (file size) movb #45 ,(r4)+ ; length of the number deccvt r1,r4,#5 ; convert to ascii mov #5 ,r0 ; convert leading spaces to '0' 10$: cmpb @r4 ,#40 ; if a space, then make it a '0' bne 20$ ; no movb #'0 ,@r4 ; yes, stuff a space in 20$: inc r4 ; next please sob r0 ,10$ ; next please clrb @r4 ; insure .asciz clr r0 ; to be safe 100$: return ; bye .sbttl dispatch on the type of attribute packet received .psect $code ; R $ A T T R ; ; input: @r5 the packet address ; output: r0 error code, zero for success r$attr::save ; just to be safe mov @r5 ,r5 movb @r5 ,r0 scan r0 ,#attrty ; look for the attribute packet type? asl r0 ; simple to do jsr pc ,@attrds(r0) ; process the attribute packet now unsave ; bye return ; exit at.$$: calls error ,<#1,#badpak> ; send error back to abort things mov #-1 ,r0 ; return 'abort' return .sbttl process specific attribute types ; File size in 1024 byte chunks (512 would have been better) at.len: save ; save temps please clr at$len ; assume zero mov r5 ,r2 ; point to the packet tstb (r2)+ ; skip the "!" atttribute type movb (r2)+ ,r0 ; get the length of the number beq 100$ ; nothing there ? sub #40 ,r0 ; convert to a real number beq 100$ ; nothing to do ? clr r1 ; init the accumulator 10$: tstb @r2 ; eol ? beq 30$ ; yep cmpb @r2 ,#40 ; ignore leading spaces please beq 20$ ; yes, a space clr -(sp) ; get the next digit please movb @r2 ,@sp ; and convert to decimal sub #'0 ,@sp ; got it mul #12 ,r1 ; shift accum over 10 add (sp)+ ,r1 ; add in the current digit 20$: inc r2 ; next ch please sob r0 ,10$ ; next digit please 30$: asl r1 ; convert 1024 blocks to 512 blocks mov r1 ,at$len ; save it please 100$: unsave ; pop temps and exit clr r0 return at.typ: cmpb 1(r5) ,#'B&137 ; 'binary' ? beq 10$ ; yes cmpb 1(r5) ,#'I&137 ; 'image' ? bne 100$ ; no 10$: mov #binary ,image ; flag for image mode then mov #binary ,at$typ ; save it here also 100$: clr r0 return at.cre: clr r0 return at.id: clr r0 return at.bil: clr r0 return at.area:clr r0 return at.pas: clr r0 return at.bsiz:clr r0 return at.acc: clr r0 return at.enc: clr r0 return at.dis: movb 1(r5) ,at$dis clr r0 return at.pr0: clr r0 return at.pr1: clr r0 return at.sys: movb 1(r5) ,at$sys ; major vendor type movb 2(r5) ,at$sys+1 ; save the system type clr r0 ; no errors return ; exit at.for: clr r0 return .sbttl recieve the ifab data for file attributes from another 11 fabsiz = 7*13 ; need at least this many at.fab: strlen r5 ; packet size ok dec r0 ; less the attribute type ('system') cmp r0 ,#fabsiz ; well.... blo 100$ ; too small, ignore the fab data call ispdp ; are we compatible today? tst r0 ; no if eq beq 100$ ; no, ignore the system dep attr's mov #at$fab ,r4 ; copy the packet over now mov r5 ,r3 ; and the source please inc r3 ; skip the attribute type header mov #-1 ,(r4)+ ; flag that the attributes are for real mov #13 ,r2 ; number of words to convert back 10$: clrb 6(r3) ; insure .asciz now calls octval , ; simple tst r0 ; successfull? bne 90$ ; no, clear flag and exit mov r1 ,(r4)+ ; and save the value now add #7 ,r3 ; point to the next octal number sob r2 ,10$ ; next please mov sp ,at$val ; it's ok to use the attributes br 100$ ; bye 90$: clr at$fab ; error exit (conversion error) 100$: clr r0 ; always flag success and exit return .sbttl utility routines pd$rsx = '8 pd$ias = '9 pd$rsts = 'A&137 pd$rt = 'B&137 pd$pos = 'C&137 ; I S P D P ; ; input: nothing ; output: r0 <> 0 if the other system is a KERMIT-11 system ; errors: none .psect $pdata pdplst: .byte pd$rsx ,pd$ias ,pd$rsts,pd$rt ,pd$pos ,0 .even .psect $code ispdp:: clr r0 ; presume failure cmpb at$sys ,#'D&137 ; a DEC system ? bne 100$ ; no, exit scan ,#pdplst 100$: return clratr::clr at$len clr at$typ clr at$cre clr at$id clr at$bil clr at$area clr at$pas clr at$bsiz clr at$acc clr at$enc clr at$dis clr at$pr0 clr at$pr1 clr at$sys clr at$for clr at$fab clr atrctx return .sbttl finish up the update of rms file attributes to output ; A T R F I N ; ; If the file was send in image mode, and we have been sent ; valid attributes (basically, the sender's IFAB), then call ; PUTATR to place these attributes into our output file's ; IFAB so they will get updated. ; ; ; Note: 11-Jul-84 17:12:49 BDN, edit /19/ ; ; Note that for RSTS/E, we have an unusual problem in that if ; the sender sent a stream ascii file (most likely a file with ; NO attributes) over and the sender said it's binary, then ; RMS-11 sends GARBAGE for the VFC header size. When this data ; is wriiten into the output file's IFAB, RMS11 finds invalid ; data in the IFAB and writes attributes to disk with the last ; block field (F$HEOF and F$LEOF) equal to ZERO. Such a file ; would thus be unreadable to PIP, RMS and other programs that ; look at the file attributes. The fix is one of two things. ; One, we can clear the invalid VFC size and fudge the record ; size and maximum record size to something usable (like 512), ; or we can simply ignore the senders attributes and let the ; file stand as a FIXED, NO CC, recordsize 512 file. Rather ; than to try to fix the attributes, we will simple ignore the ; attributes if the sender said that the file is stream ascii ; with a garbage VFC. Since the attributes are only used if ; the transfer was in image moed, this will not affect normal ; files, only files like DMS-500 files that have no attributes ; but must be sent in image mode. ; Of course, the sending Kermit-11 can always be given the SET ; ATT OFF and SET FIL BIN and the receiving Kermit-11 be given ; the SET FIL BIN and the issue will never arise. ; ; The mods are noted with /19/ after the statement. atrfin::save ; just in case please tst @r5 ; lun zero ? beq 100$ ; yep tst at$val ; valid attributes to write ? beq 100$ ; no cmpb at$typ ,#binary ; did we get this as a binary file? bne 100$ ; no mov #at$fab ,r1 ; yes tst (r1)+ ; valid data present ? beq 100$ ; no cmp @r1 ,#2000 ; /19/ stream ascii ? bne 30$ ; /19/ no cmp 16(r1) ,#177400 ; /19/ garbage for the vfc header size? beq 90$ ; /19/ yes, forget about the attributes 30$: calls putatr ,<@r5,r1> ; /19/ update the ifab for the file 90$: clr at$typ ; /19/ no longer valid please clr at$fab ; no longer valid please clr at$val ; no longer valid please 100$: unsave ; output file and exit return 200$: .byte 40,0 .end