home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / test / pdp11 / krtser.mac < prev    next >
Text File  |  1996-10-17  |  31KB  |  892 lines
  1.     .title    KRTSER    The server
  2.     .ident    "V04.64"
  3.  
  4. ; /E64/    28-Apr-96  John Santos
  5. ;
  6. ;    Conditionalize for RSTS/E
  7. ;    Check for errors after fparse
  8.  
  9. ; /63/    18-Feb-96  Billy Youdelman
  10. ;
  11. ;    disallow gets to TT
  12. ;    gen.h now displays the real version data ala SHO VER
  13. ;    clean up remote command response code, display reasons for retries
  14. ;    move C$BYE and REMFIN into now improved REMOTE command processor
  15. ;    on error resend REMOTE command packet before listening again
  16. ;    dump BUFPAK, use BUFFIL instead for repeated char encoding
  17.  
  18. ; /62/    27-Jul-93  Billy Youdelman  V03.62
  19. ;
  20. ;    allow server to talk through the comm handler too..
  21. ;    move dispatch macro here
  22. ;    add newline in log file at each new process
  23.  
  24. ; /BBS/     1-Dec-91  Billy Youdelman  V03.61
  25. ;
  26. ;    gen.t filespec more carefully tested, defaults to .LST type
  27. ;    double prompt on server exit killed by hosing ^M in FIN packet
  28. ;    remget - now uses srcnam for input file
  29. ;    no args to server command allowed under RT/TSX
  30. ;    input file name to serv.r checked by fparse
  31. ;    gen.c inserts colon after device name if necessary
  32. ;    gen.w - remote who via xreply added
  33. ;    upcase incoming remote command args, so mskerm is happy
  34. ;    gen.d checks for valid device before initiating any output,
  35. ;    defaults to DK if no arg given, as from MSKermit
  36. ;    modified gen.u to use krtdir
  37. ;    remspa accepts optional device argument, gen.u passes to krtdir
  38. ;    remfin returns error status in r0, to CONNECT if FINISH succeeds
  39. ;    disallow running server unless link device is TT
  40.  
  41. ;    Brian Nelson  22-Dec-83  12:16:59
  42. ;
  43. ;    This is the server module for Kermit-11
  44. ;    it also has the modules to talk to a remote Kermit
  45.  
  46.  
  47.     .include "IN:KRTMAC.MAC"
  48.     .iif ndf  KRTINC  .error    <; .include for IN:KRTMAC.MAC failed>
  49.     .include "IN:KRTDEF.MAC"
  50.     .iif ndf  MSG$DA  .error    <; .include for IN:KRTDEF.MAC failed>
  51.  
  52. .if df    RT11                ; /E64/
  53.     .mcall    .PURGE            ; /62/
  54. .endc    ;RT11                ; /E64/
  55.  
  56.  
  57.     .macro    dispat    val,dsp,baseval,basedsp,default    ; cmd dispatch tables
  58.     .list me
  59.     .save
  60.     .nlist me
  61.     .if nb <baseval>
  62.     .list me
  63.     .psect    genval    ,ro,d,lcl,rel,con
  64. baseval:
  65.     .psect    gendsp    ,ro,d,lcl,rel,con
  66. basedsp:
  67.     .word    default
  68.     .nlist me
  69.     .iff
  70.     .list me
  71.     .psect    genval    ,ro,d,lcl,rel,con
  72.     .nlist me
  73.       .if b  <val>
  74.       .byte     0
  75.       .even
  76.       .iff
  77.       .byte     val
  78.       .list     me
  79.       .psect gendsp    ,ro,d,lcl,rel,con
  80.       .nlist me
  81.       .word     dsp
  82.       .endc
  83.     .endc
  84.     .list me
  85.     .restore
  86.     .nlist me
  87.     .endm
  88.  
  89.  
  90.     .sbttl    Local data
  91.  
  92.     .psect    $pdata            ; /62/ consolidated this stuff here..
  93. delmsg:    .asciz    " deleted"
  94. exitxt:    .asciz    <cr><lf>"%KRTSER-I-Server stopped"<cr><lf>
  95.     .blkb    ln$max            ; /63/ buffer to prepend version data
  96. htxt:    .ascii    <cr><lf>"       Server REMOTE commands:"<cr><lf><cr><lf>
  97.     .ascii    "       BYE     Stop server and logout"<cr><lf>
  98.     .ascii    "REMOTE COPY    Copy a file to another"<cr><lf>
  99.     .ascii    "REMOTE CWD     Change server working directory"<cr><lf>
  100.     .ascii    "REMOTE DELETE  Delete specified file"<cr><lf>
  101.     .ascii    "REMOTE DIR     Display a directory"<cr><lf>
  102.     .ascii    "       FINISH  Stop server leaving Kermit running"<cr><lf>
  103.     .ascii    "       GET     Get file(s) from server"<cr><lf>
  104.     .ascii    "REMOTE HELP    Display this help text"<cr><lf>
  105.     .ascii    "REMOTE RENAME  Rename a file"<cr><lf>
  106.     .ascii    "       SEND    Send file(s) to server"<cr><lf>
  107.     .ascii    "REMOTE SPACE   Show available disk space"<cr><lf>
  108.     .asciz    "REMOTE TYPE    Type specified file"<cr><lf>
  109. ;    .asciz    "REMOTE WHO     Show active BBS lines"<cr><lf>
  110. invarg:    .asciz    "?KRTSER-E-Invalid argument(s)"
  111. notimp:    .asciz    "?KRTSER-W-Unimplemented command"
  112. rem.01:    .asciz    "Receive XREPLY failed"
  113. rem.02:    .asciz    "Try "
  114. rem.03:    .asciz    " of "
  115. rem.04:    .asciz    " got invalid response"
  116. rem.05:    .asciz    " checksum failed"
  117. rem.06:    .asciz    " was NAKed"
  118. rem.07:    .asciz    " timed out"
  119. rem.08:    .asciz    "1 file renamed"    ; /BBS/
  120. rem.ak:    .asciz    "Remote ACK:"<cr><lf>
  121. ser.01:    .asciz    <bell>"Get completed"
  122. ser.02:    .asciz    <bell>"Get failed"
  123. ser.03:    .asciz    'Processing file name "'
  124. ser.04:    .asciz    '"'
  125. ser.05:    .asciz    " block(s) copied to "    ; /BBS/
  126. ser.06:    .asciz    "DK  --> "
  127. serpre:    .asciz    "%KRTSER-I-Server starting"
  128. sertxt:    .ascii    ".  Return to your local machine by typing"<cr><lf>
  129.     .ascii    "its escape sequence for closing the connection,"
  130.     .ascii    " then issue further"<cr><lf>
  131.     .ascii    "commands from there.  To shut down the server,"
  132.     .ascii    " use the BYE command"<cr><lf>
  133.     .asciz    "to logout, or the FINISH command and then reconnect."
  134. serwn0:    .asciz    "Connecting to "
  135. serspd:    .asciz    "  DTE speed: "
  136. serspx:    .asciz    "N/A"
  137. serwn1:    .asciz    <cr><lf><cr><lf><bell><bell>"?KRTSER-W-Type ^C "
  138. serwn2:    .asciz    " times to stop the server from this terminal"<cr><lf><cr><lf>
  139. typdef:    .asciz    ".LST"
  140.     .even
  141.  
  142.     .psect    $rwdata    ,rw,d,lcl,rel,con
  143. rem.d0:    .blkb    4
  144. rem.d1:    .blkb    4
  145.  
  146.  
  147.     .psect    $code
  148.     .sbttl    Call the server
  149.  
  150. c$serv::tstb    @argbuf            ; if no arg, do normal server
  151.     beq    10$            ; /BBS/ ok
  152.     mov    #er$ser    ,r0        ; /BBS/ subcommands are not supported
  153.     br    70$            ; /BBS/ goto error handler
  154.  
  155. 10$:    call    seropn            ; /63/ includes cantyp + buffer flush
  156.     tst    r0            ; /62/ did it work?
  157.     bne    80$            ; /62/ no, error msg dumped by ttyini
  158.     tst    remote            ; /62/ local or remote?
  159.     bne    40$            ; /62/ remote, do appropriate message
  160.     wrtall    #serwn0            ; /62/ local, say where
  161.     wrtall    #ttname            ; /62/ we're connected
  162.     wrtall    #serspd            ; /62/
  163.     call    ttspeed            ; /62/ get speed
  164.     tst    r0            ; /62/ wuz it gettable?
  165.     bne    20$            ; /62/ yup..
  166.     wrtall    #serspx            ; /62/ nope
  167.     br    30$            ; /62/ continue
  168. 20$:    call    L10266            ; /62/ speed in r0 to TT
  169. 30$:    .newline            ; /62/
  170.     wrtall    #serpre            ; /62/ the minimum sign-on message..
  171.     wrtall    #serwn1            ; /62/ and how to abort
  172.     mov    cc$max    ,r0        ; /62/ it takes this many ^Cs
  173.     inc    r0            ; /62/ plus one for the .scca trap
  174.     call    L10266            ; /62/ put the total on the terminal
  175.     wrtall    #serwn2            ; /62/ and tag the display
  176.     br    60$            ; /62/ leave cursor at end of the line
  177.  
  178. 40$:    wrtall    #serpre            ; /62/ the minimum sign-on message..
  179.     tst    infomsg            ; /41/ should we be verbose today?
  180.     beq    50$            ; /41/ no
  181.     wrtall    #sertxt            ; dump a message out please
  182. 50$:    .newline            ; /62/ tag minimum or whole message..
  183. 60$:    mov    sp    ,inserv        ; global flag to say we are a server
  184.     call    server            ; and do it
  185.     clr    inserv            ; no longer a server
  186.     wrtall    #exitxt            ; /BBS/ emulate C-Kermit..
  187.     br    80$
  188.  
  189. 70$:    direrr    r0            ; /BBS/ handle the error
  190. 80$:    clr    r0            ; /62/ success (error just handled..)
  191.     jmp    clostt            ; /62/ close up the link
  192.  
  193.  
  194.     .sbttl    Server main_loop
  195.  
  196. server:    clr    paknum            ; packet_number := 0
  197.     clr    cccnt            ; /38/ clear ^C flag
  198.     textsrc                ; /38/ reset to normal file I/O
  199.     mov    #defchk    ,chktyp        ; checksum_type := type_1
  200.     mov    #1    ,chksiz        ; checksum_len := 1
  201.     mov    $image    ,image        ; ensure correct default is set
  202.     clr    summary            ; /BBS/ reset summary only flag
  203. .if df    RT11                ; /E64/
  204.     clr    dirflg            ; /62/ reset embedded blanks flag
  205. .endc    ;RT11                ; /E64/
  206.     call    fixchk            ; sendpar_checktype := set_checktype
  207.     mov    serwai    ,sertim        ; /41/ set a new time-out please
  208.     bit    #log$pa    ,trace        ; /62/ logging packets this time?
  209.     beq    10$            ; /62/ no
  210.     calls    putrec    ,<#0,#0,#lun.lo> ; /62/ ya, put newline into log file
  211.     tst    r0            ; /62/ did it work?
  212.     beq    10$            ; /62/ ya
  213.     call    logerr            ; /62/ no, handle the error
  214. 10$:    rpack    r2 ,r3    ,#packet,#maxlng ; /62/ loop forever
  215.     clr    sertim            ; normal time-outs now
  216.     movb    sentim    ,senpar+p.time    ; /62/ default to send time-out
  217.     scan    r1    ,#sercom    ; find the command in dispatch table
  218.     asl    r0            ; word indexing
  219.     jsr    pc    ,@serdsp(r0)    ; go run it
  220.     tst    r0            ; done?
  221.     beq    server            ; /BBS/ no, next server command please
  222.  
  223.     calls    suspend    ,<#1>        ; /BBS/ sleep a second
  224.     jmp    clrcns            ; /62/ kill "double prompt" on exit
  225.  
  226.  
  227.     dispat    basedsp=serdsp    ,baseval=sercom    ,default=serv.$
  228.  
  229.     dispat    BADCHK        ,serchk    ; a fubar checksum
  230.     dispat    MSG$ACK        ,serv$$    ; things are ok now
  231.     dispat    MSG$ERROR    ,sernop    ; ignore "E" packets from remote
  232.     dispat    MSG$GENERIC    ,serv.g    ; do a server command
  233.     dispat    MSG$NAK        ,serv$$    ; a NAK this time
  234.     dispat    MSG$RCV        ,serv.r    ; send a file
  235.     dispat    MSG$SER        ,serv.i    ; do a server sinit
  236.     dispat    MSG$SND        ,serv.s    ; init to receive a file
  237.     dispat    TIMOUT        ,serv$$    ; we timed out
  238.     dispat
  239.  
  240.  
  241.     .sbttl    Server routines
  242.  
  243. gen.$:                    ; /63/ unimplemented generic cmd
  244. serv.$:    strlen    #notimp            ; get length of this text into r0
  245.     spack    #msg$error,paknum,r0,#notimp ; ignore unrecognized packet type
  246.     clr    r0            ; not done yet
  247.     return
  248.  
  249. serv$$:                    ; /62/ time-out, send a NAK please
  250. serchk:    mov    r3    ,paknum        ; NAK checksum errors
  251.     spack    #msg$nak,paknum        ; send the NAK out please
  252. sernop:    clr    r0            ; /62/ we are not done
  253.     return
  254.  
  255. serv.i:    mov    r3    ,paknum        ; we got an init packet
  256.     calls    rpar    ,<#packet,r2>    ; save the other Kermit's parameters
  257.     calls    spar    ,<#packet>    ; get our parameters
  258.     spack    #msg$ack,paknum,sparsz,#packet ; send them to the other Kermit
  259.     clr    r0            ; not done
  260.     jmp    inirepeat        ; /62/ init repeat char encoding
  261.  
  262. serv.s:    mov    r3    ,paknum        ; got an sinit, init packet number
  263.     calls    rpar    ,<#packet,r2>    ; store their send init info away
  264.     calls    spar    ,<#packet>    ; and send them ours for the ACK
  265.     spack    #msg$ack,paknum,sparsz,#packet
  266.     call    inirepeat        ; do repeat initialization
  267.     incm64    paknum            ; paknum := paknum+1 mod 64
  268.     calls    rec.sw    ,<#sta.fil>    ; and get set to receive a file name
  269.     clr    r0            ; not done
  270.     return
  271.  
  272. serv.r:    calls    bufunp    ,<#packet,#spare1> ; /BBS/ use a spare buff
  273.     clrb    spare1(r1)        ; /53/ null terminate it
  274.     upcase    #spare1            ; /BBS/ upper case it
  275.     calls    fparse,<#spare1,#srcnam> ; /BBS/ make sure it's an ok device
  276.     tst    r0            ; /BBS/ is it?
  277.     bne    10$            ; /BBS/ nope..
  278.     calls    fixwild    ,<#srcnam>    ; /BBS/ change "?" to "%"
  279.     clr    index            ; first file in directory please
  280.     call    getnxt            ; get the first file name
  281.     tst    r0            ; did it work?
  282.     bne    20$            ; no, getnxt has sent the error pak
  283.     calls    sensw    ,<#sta.sin>    ; ya, send the file(s)
  284.     br    20$
  285.  
  286. 10$:    call    generr            ; /BBS/ send an error message
  287. 20$:    clr    r0            ; not done
  288.     return
  289.  
  290.  
  291.     .sbttl    Generic command processor
  292.  
  293. serv.g:    clr    at$len            ; /BBS/ used for local sizes too..
  294. .if df    RSTS                ; /E64/
  295.     clr    at$len+2        ; /E64/ used for local sizes too..
  296. .endc    ;RSTS                ; /E64/
  297.     sub    #200    ,sp        ; /53/ make a temp copy of data
  298.     mov    sp    ,r2        ; /53/ point to it
  299.     copyz    #packet    ,r2    ,#176    ; /62/ copy, but don't lunch stack!
  300.     calls    bufunp    ,<r2,#packet>    ; /53/ undo it (with repeats)
  301.     add    #200    ,sp        ; /53/ pop buffer
  302.     movb    packet+0,r2        ; first data byte is generic cmd type
  303.     scan    r2    ,#gencom    ; find it's command address
  304.     asl    r0            ; word indexing
  305.     jmp    @gendsp(r0)        ; /62/ dispatch the command
  306.  
  307.     dispat    basedsp=gendsp    ,baseval=gencom    ,default=gen.$
  308.  
  309.     dispat    GN$BYE        ,gen.l    ; bye bye
  310.     dispat    GN$CONNECT    ,gen.c    ; connect here means to a directory
  311.     dispat    GN$COPY        ,gen.k    ; copy a file
  312.     dispat    GN$DELETE    ,gen.e  ; delete file
  313.     dispat    GN$DIRECTORY    ,gen.d    ; directory (of a disk)
  314.     dispat    GN$DISK        ,gen.u    ; disk usage
  315.     dispat    GN$EXIT        ,gen.f    ; exit server, return to command mode
  316.     dispat    GN$HELP        ,gen.h    ; help
  317.     dispat    GN$RENAME    ,gen.r    ; rename a file
  318.     dispat    GN$TYPE        ,gen.t    ; type a file
  319. ;    dispat    GN$WHO        ,gen.w    ; who's on-line
  320.     dispat
  321.  
  322.  
  323.     .sbttl    Kermit generic routines
  324.  
  325. gen.f:    spack    #msg$ack,paknum        ; send a simple ACK
  326.     mov    sp    ,r0        ; all done, return to command mode
  327.     jmp    clostt            ; /62/ close the terminal up and exit
  328.  
  329. gen.l:    spack    #msg$ack,paknum        ; assume we can log out
  330.     call    clostt            ; close the terminal please
  331.     bit    #log$op    ,trace        ; a logfile open now?
  332.     beq    10$            ; no
  333.     calls    close    ,<#lun.lo>    ; yes, close it please
  334. 10$:    jmp    logout            ; log out of the system
  335.  
  336.  
  337.     .sbttl    Generic COPY
  338.  
  339. gen.k:    call    get2ar            ; get pointers to "from" and "to"
  340.     bcs    20$            ; oops, send an error packet over
  341.     upcase    r1            ; /BBS/ upper case first arg
  342.     upcase    r2            ; /BBS/ upper case second arg
  343.     calls    fparse    ,<r1,#srcnam>    ; /62/ get attrs here as lookup is in
  344. .if df    RSTS                ; /E64/
  345.     tst    r0            ; /E64/ did it work?
  346.     bne    10$            ; /E64/ no
  347. .endc    ;RSTS                ; /E64/
  348.     clr    index            ; /62/ an adjacent overlay  init index
  349.     calls   lookup  ,<#srcnam,#spare1> ; /62/ load input file attributes
  350. .if df    RT11                ; /E64/
  351.     .purge    #lun.sr            ; /62/ dump lookup channel
  352. .endc    ;RT11                ; /E64/
  353.     calls    copy    ,<r1,r2>    ; copy the file now
  354.     tst    r0            ; did it work?
  355.     bne    10$            ; no
  356.     sub    #100    ,sp        ; /63/ yes, formulate a simple ACK
  357.     mov    sp    ,r3        ; /BBS/ response telling them how many
  358.     deccvt    r1 ,r3    ,#5        ; /BBS/ blocks that we copied over
  359.     add    #5    ,r3        ; /BBS/ point past the block count
  360.     strcpy    r3    ,#ser.05    ; /62/ copy a message and then ACK it
  361.     strcat    r3    ,#filnam    ; /BBS/ tag it with create file name
  362.     mov    sp    ,r3        ; /BBS/ point back to start of buffer
  363.     strlen    r3            ; /BBS/ get the string length now
  364.     spack    #msg$ack,paknum,r0,r3    ; /BBS/ send the ACK over
  365.     add    #100    ,sp        ; /63/ pop the local buffer
  366.     br    30$
  367.  
  368. 10$:    call    generr            ; error, send RMS error text
  369.     br    30$
  370.  
  371. 20$:    calls    error    ,<#1,#invarg>    ; invalid arguments
  372. 30$:    clr    r0            ; not done yet
  373.     return
  374.  
  375.  
  376.     .sbttl    Generic CWD
  377.  
  378. gen.c:    mov    #packet+1,r1        ; get the packet address
  379.     unchar    (r1)+    ,r2        ; get the size of the data
  380.     bne    10$            ; /63/ something is there
  381.     strcpy    r1    ,#dkname    ; /63/ if no dev specified, then home
  382.     strlen    r1            ; /63/ get length of name copied in
  383.     mov    r0    ,r2        ; /63/ and replace packet len with it
  384.  
  385. 10$:    cmp    r2    ,#4        ; /63/ a possibly legal name?
  386.     ble    30$            ; /63/ ya
  387. 20$:    mov    #er$dna    ,r0        ; /63/ no, name is no good
  388.     br    50$            ; /63/ goto error handler
  389.  
  390. 30$:    mov    r2    ,r0        ; /63/ save copy of length
  391.     add    r1    ,r2        ; /BBS/ point to the end of it all
  392.     dec    r2            ; /BBS/ bump back to last char in buff
  393.     cmpb    (r2)+    ,#':        ; /BBS/ last byte a colon?
  394.     beq    40$            ; /BBS/ ya
  395.     cmp    r0    ,#3        ; /63/ if no end colon max len is 3 ch
  396.     bhi    20$            ; /63/ it's too long
  397.     movb    #':    ,(r2)+        ; /BBS/ no, but fparse needs one
  398.  
  399. 40$:    clrb    @r2            ; /BBS/ (re)terminate
  400.     upcase    r1            ; /BBS/ upper case the packet
  401.     calls    fparse,<r1,#spare1>    ; /BBS/ use handy buffer to verify
  402.     tst    r0            ; /BBS/ it's an authorized device
  403.     bne    50$            ; /BBS/ nope, it's not..
  404.     strcpy    #defdir    ,#spare1    ; /62/ modify defdir
  405.     sub    #40    ,sp        ; allocate a buffer
  406.     mov    sp    ,r2        ; point to the buffer
  407.     strcpy    r2    ,#ser.06    ; /62/ stick "DK --> " in it..
  408.     strcat    r2    ,#defdir    ; add the directory name in
  409.     strlen    r2            ; get the total length
  410.     spack    #msg$ack,paknum,r0,r2    ; and sent the ACK message
  411.     add    #40    ,sp        ; pop buffer
  412.     br    60$
  413.  
  414. 50$:    call    generr            ; handle error
  415. 60$:    clr    r0            ; not done
  416.     return
  417.  
  418.  
  419.     .sbttl    Generic DELETE
  420.  
  421. gen.e:    mov    #packet+1,r1        ; get the packet address
  422.     unchar    (r1)+    ,r2        ; get the argument length
  423.     bne    10$            ; non-zero
  424.     clrb    @r1            ; zero, make the string null
  425. 10$:    upcase    r1            ; /BBS/ upper case the packet
  426.     calls    delete    ,<r1,#lun.ou>    ; do it
  427.     tst    r0            ; did it work?
  428.     beq    20$            ; yes
  429.     call    generr            ; no, send the RMS error code over
  430.     br    30$
  431.  
  432. 20$:    ; /BBS/ wildcarding not available under RT-11
  433.     strcpy    #errtxt    ,#srcnam    ; /62/ reply for 1 file deleted
  434.     strcat    #errtxt    ,#delmsg    ; /62/ append " deleted" to file name
  435.     strlen    #errtxt            ; get the length
  436.     spack    #msg$ack,paknum,r0,#errtxt ; and send a simple ACK packet
  437. 30$:    clr    r0            ; not done with the server yet
  438.     return
  439.  
  440.  
  441.     .sbttl    Generic DIRECTORY and SPACE
  442.  
  443. gen.u:    mov    sp    ,summary    ; /BBS/ flag for a summary only
  444. gen.d:    mov    #packet+1,r1        ; /38/ get the packet address
  445.     unchar    (r1)+    ,r2        ; /38/ get the argument length
  446.     add    r1    ,r2        ; /BBS/ point to the end
  447.     clrb    @r2            ; /BBS/ null terminate
  448.     upcase    r1            ; /BBS/ upper case the packet
  449.     calls    fixwild    ,<r1>        ; /BBS/ convert "?" to "%"
  450.     calls    sdirini    ,<r1>        ; /38/ init directory lookup and
  451.     tst    r0            ; /38/ preload sdodir's buffer
  452.     bne    10$            ; /38/ send error packet on any error
  453.     mov    #sdodir    ,getcroutine    ; /38/ stuff address of get_next_char
  454.     mov    #null    ,r0        ; /38/ and flag we're NOT using a file
  455.     call    xreply            ; /38/ do the extended reply now
  456.     tst    r0            ; did it work?
  457.     beq    20$            ; ya
  458. 10$:    call    generr            ; /BBS/ send error to the user
  459. 20$:    clr    r0            ; not done yet
  460.     return
  461.  
  462.  
  463.     .sbttl    Generic HELP
  464.  
  465. gen.h:    calls    get$ve    ,<#spare1>    ; /63/ use the actual version data
  466.     mov    #spare1    ,r1        ; /63/ which we will prepend to htxt
  467.     strlen    r1            ; /63/ get its length into r0
  468.     add    r0    ,r1        ; /63/ and a pointer to its end
  469.     cmp    r0    ,#ln$max    ; /63/ is the length within range?
  470.     blos    10$            ; /63/ yes
  471.     mov    #ln$max    ,r0        ; /63/ no, but it is now!
  472. 10$:    mov    #htxt    ,r2        ; /63/ start the prepended data here
  473. 20$:    movb    -(r1)    ,-(r2)        ; /63/ copy it across backwards so it
  474.     sob    r0    ,20$        ; /63/ is in front of the static htxt
  475.     textsrc    r2            ; /63/ help text now begins here
  476.     mov    #null    ,r0        ; /38/ flag it's not file I/O..
  477.     call    xreply            ; /38/ send it
  478.     clr    r0            ; /38/ not done yet
  479.     return
  480.  
  481.  
  482.     .sbttl    Generic RENAME
  483.  
  484. gen.r:    call    get2ar            ; get pointers to "from" and "to"
  485.     bcs    20$            ; oops, send an error packet over
  486.     upcase    r1            ; /BBS/ upper case first arg
  487.     upcase    r2            ; /BBS/ upper case second arg
  488.     calls    rename    ,<r1,r2,#-1>    ; rename the file now
  489.     tst    r0            ; did it work out ok?
  490.     bne    10$            ; no
  491.     strlen    #rem.08            ; /62/ get the string length
  492.     spack    #msg$ack,paknum,r0,#rem.08 ; /62/ send the ACK over
  493.     br    30$
  494.  
  495. 10$:    call    generr            ; error, send RMS error text
  496.     br    30$
  497.  
  498. 20$:    calls    error    ,<#1,#invarg>    ; invalid arguments
  499. 30$:    clr    r0            ; not done yet
  500.     return
  501.  
  502.  
  503.     .sbttl    Generic TYPE
  504.  
  505. gen.t:    mov    #packet+1,r1        ; get the packet address
  506.     unchar    (r1)+    ,r2        ; get the argument length
  507.     beq    20$            ; /BBS/ nothing was there
  508.     add    r1    ,r2        ; /BBS/ point to end
  509.     clrb    @r2            ; /BBS/ null terminate
  510.     upcase    r1            ; /BBS/ upper case the packet
  511.     scan    #'.    ,r1        ; /BBS/ look for a dot in the name
  512.     tst    r0            ; /BBS/ find one?
  513.     bne    10$            ; /BBS/ ya..
  514.     strcat    r1    ,#typdef    ; /BBS/ no, add ".LST" to it
  515. 10$:    calls    iswild    ,<r1>        ; /BBS/ wildcarded file_spec??
  516.     tst    r0            ; /BBS/
  517.     bne    30$            ; /BBS/ disallow wildcarded file_spec
  518.     calls    fparse,<r1,#spare1>    ; /BBS/ be sure it's an auth'd dev..
  519.     tst    r0            ; /BBS/ is it?
  520.     beq    40$            ; /BBS/ nope
  521.     mov    #er$dna    ,r0        ; /63/ bad device name
  522.     br    30$
  523.  
  524. 20$:    mov    #er$fnm    ,r0        ; /BBS/ bad file name
  525. 30$:    call    generr            ; /BBS/ handle the error
  526.     br    50$
  527.  
  528. 40$:    mov    #spare1    ,r0        ; point to file to be typed
  529.     call    xreply            ; send it as an extended reply
  530. 50$:    clr    r0            ; not done yet
  531.     return
  532.  
  533.  
  534. ;    .sbttl    Generic WHO
  535. ;
  536. ;gen.w:    calls    systat,<#1>        ; load output into out buff
  537. ;    textsrc    #whobuff        ; aim out buff at packet buffer
  538. ;    mov    #null    ,r0        ; flag it's not file I/O
  539. ;    call    xreply            ; do the extended reply now
  540. ;    clr    r0            ; not done yet
  541. ;    return
  542.  
  543.  
  544.     .sbttl    Generic command error handler
  545.  
  546. generr:    calls    syserr    ,<r0,#errtxt>    ; /BBS/ be more informative
  547.     calls    error    ,<#1,#errtxt>    ; get the error text and send it
  548.     clr    r0            ; not done yet
  549.     return
  550.  
  551.  
  552.     .sbttl    Get pointers for a two argument server command
  553.  
  554. ;    input:    packet    = packet just read as a server, .asciz
  555. ;    output:      r1    = first argument address in packet buffer
  556. ;          r2    = second argument address..
  557. ;        carry    = set on missing arg, clear if all is well and good
  558.  
  559. get2ar:    save    <r3,r4>
  560.     mov    #packet+1,r3        ; get the address of our parameters
  561.     tstb    @r3            ; a null here is an error
  562.     beq    10$            ; exit with carry set
  563.     unchar    (r3)+    ,r4        ; get the length of the first arg
  564.     beq    10$            ; a null string, exit with error
  565.     mov    r3    ,r1        ; not null, point to the first one
  566.     add    r4    ,r3        ; point to the length field for 2nd
  567.     tstb    @r3            ; must not be null or zero
  568.     beq    10$            ; null, missing second argument
  569.     unchar    (r3)+    ,r4        ; get the length of the last field
  570.     beq    10$            ; nothing is there, abort please
  571.     mov    r3    ,r2        ; return a pointer to the second arg
  572.     clrb    -(r3)            ; /63/ terminate 1st arg, clear carry
  573.     br    20$
  574. 10$:    sec                ; failure, to try again someday
  575. 20$:    unsave    <r4,r3>
  576.     return
  577.  
  578.  
  579.     .sbttl    The GET command        ; /BBS/ heavily modified
  580.  
  581. c$get::    call    ckremote        ; /62/ moved c$get here from the root
  582.     bcc    10$            ; /63/ local, no problem
  583.     jmp    120$            ; /63/ we are remote, abort this
  584. 10$:    clr    wasmore            ; init multi-args display flag
  585.  
  586. 20$:    mov    argbuf    ,r1        ; address of command line buffer
  587.     tstb    @r1            ; anything there?
  588.     beq    40$            ; nope, bail out
  589.     call    isitas            ; get asname if there
  590.     tst    r0            ; any error in syntax?
  591.     beq    30$            ; /63/ no, it's ok
  592.     mov    #er$get    ,r0        ; /63/ emit a syntax error message
  593.     br    40$            ; /63/
  594. 30$:    calls    chk.tt    ,<#asname>    ; /63/ disallow getting to TT
  595.     tst    r0            ; /63/ well?
  596.     beq    50$            ; /63/ it's not TT
  597. 40$:    direrr    r0            ; /63/ display error message
  598.     br    120$            ; bail out
  599.  
  600. 50$:    tst    wasmore            ; working with more than 1 file spec?
  601.     beq    60$            ; no
  602.     calls    printm    ,<#3,#ser.03,#srcnam,#ser.04> ; ya, say which it is
  603. 60$:    upcase    #asname            ; just in case
  604.     tst    locase            ; SET FILE NAMING LOWER-CASE?
  605.     bne    70$            ; ya
  606.     upcase    #srcnam            ; no, make it upper case
  607. 70$:    movb    rectim    ,senpar+p.time    ; /62/ use receive time-out
  608.     call    seropn            ; init the link
  609.     tst    r0            ; /BBS/ did it work?
  610.     bne    80$            ; /BBS/ no, error msg dumped by ttyini
  611.     call    sinfo            ; exchange information please
  612.     clr    paknum            ; packet_number := 0
  613.     strlen    #srcnam            ; get the length of the file name
  614.     spack    #msg$rcv,paknum,r0,#srcnam ; get the server to send this file
  615.     calls    recsw    ,<#sta.rin>    ; and call the receiver
  616. 80$:    call    clostt            ; /62/ close the remote link
  617.     tst    r0            ; did it work?
  618.     bne    110$            ; no
  619.     mov    nextone    ,r0        ; ya, any more arguments to process?
  620.     bne    90$            ; ya, go do it
  621.     calls    printm    ,<#1,#ser.01>    ; /62/ no, done
  622.     br    130$            ; note r0 is clear here too
  623. 90$:    cmpb    (r0)    ,#space        ; is first byte a blank?
  624.     bne    100$            ; no
  625.     inc    r0            ; ya, skip past it
  626.     br    90$            ; and check what is now the first byte
  627. 100$:    copyz    r0 ,argbuf ,#ln$max    ; pull up remaining args to top of buf
  628.     jmp    20$            ; /63/ loop back for more
  629.  
  630. 110$:    calls    printm    ,<#1,#ser.02>    ; /62/ it failed, say so if local
  631. 120$:    inc    status            ; /45/ flag for batch exit
  632. 130$:    clrb    asname            ; /36/ ensure no more alternate names
  633.     jmp    clrcns            ; /62/ flush TT input, clear r0
  634.  
  635.  
  636.     .sbttl    The REMOTE HOST command    ; /63/ spiffed up..
  637.  
  638. remhos::call    seropn            ; init the link
  639.     tst    r0            ; /BBS/ did it work?
  640.     beq    10$            ; /BBS/ ya
  641.     jmp    xit            ; /BBS/ no, error msg dumped by ttyini
  642. 10$:    call    inista            ; /63/ init all the stats registers
  643.     movb    sentim    ,senpar+p.time    ; /63/ use send time-out
  644.     call    sinfo            ; exchange information please
  645.     clr    paknum            ; packet_number := 0  (must do this)
  646.     clr    numtry            ; /62/ clear the retry counter please
  647. ;;;    mov    sp    ,logini        ; /62/ force result msgs to a newline
  648.     calls    buffil    ,<argbuf,cmdbuf> ; /63/ do repeat encoding if need be
  649. 20$:    strlen    cmdbuf            ; /63/ get this way in case of retry
  650.     spack    #msg$com,paknum,r0,cmdbuf ; /63/ get the server to execute
  651. 30$:    rpack    r2 ,r3    ,#packet,#maxlng ; /62/ get the response from remote
  652.     mov    r3    ,paknum        ; save the packet number please
  653.     scan    r1    ,#remrsp    ; what to do with the response
  654.     asl    r0            ; word indexing
  655.     jsr    pc    ,@remdsp(r0)    ; and dispatch on the response
  656.     bit    #1    ,r0        ; /63/ is number of retires odd?
  657.     bne    30$            ; /63/ just listen for tries 1,3,5,..
  658.     tst    r0            ; try again?
  659.     bne    20$            ; /63/ must be try 2,4,6,.. resend too
  660.     jmp    xit            ; /63/ no, we are done
  661.  
  662.  
  663.     .sbttl    GENERIC REMOTE commands
  664.  
  665. c$bye::    call    ckremote        ; /62/ moved front end here
  666.     bcs    10$            ; /62/ we are remote, abort this
  667.     calls    doremo    ,<#gn$bye,#1,#null> ; /63/ do the BYE command
  668. 10$:    clr    r0            ; /62/
  669.     return
  670.  
  671. remcop::calls    doremo    ,<#gn$cop,#2,cmdbuf,argbuf> ; /62/ remote copy
  672.     return
  673.  
  674. remcwd::mov    #gn$con    ,r0        ; /63/ do connect to a dir command
  675. rem.two:mov    argbuf    ,r1        ; check for optional password
  676. 10$:    tstb    @r1            ; end of string?
  677.     beq    20$            ; yes
  678.     cmpb    (r1)+    ,#space        ; look for a space
  679.     bne    10$            ; not yet..
  680.     tstb    @r1            ; null here?
  681.     beq    20$            ; yes, no password present
  682.     clrb    -1(r1)            ; /63/ insert null where <space> was
  683.     calls    doremo    ,<r0,#2,argbuf,r1> ; /63/ ya, insert password too
  684.     br    30$
  685. 20$:    calls    doremo    ,<r0,#1,argbuf>    ; /63/ no password today
  686. 30$:    return
  687.  
  688. remdel::calls    doremo    ,<#gn$del,#1,argbuf> ; /62/ remote delete
  689.     return
  690.  
  691. remdir::calls    doremo    ,<#gn$dir,#1,argbuf> ; /62/ remote directory
  692.     return
  693.  
  694. remfin::calls    doremo    ,<#gn$exit,#1,#null> ; /63/ finish
  695.     return
  696.  
  697. remhlp::calls    doremo    ,<#gn$hel,#1,#null> ; remote help
  698.     return
  699.  
  700. remlgi::mov    #gn$log    ,r0        ; /63/ do login command
  701.     br    rem.two            ; /63/ common code
  702.  
  703. remren::calls    doremo    ,<#gn$ren,#2,cmdbuf,argbuf> ; /62/ remote rename
  704.     return
  705.  
  706. remspa::calls    doremo    ,<#gn$dis,#1,argbuf> ; /62/ remote space
  707.     return                     ; /BBS/ with possible device
  708.  
  709. remtyp::calls    doremo    ,<#gn$typ,#1,argbuf> ; /62/ remote type
  710.     return
  711.  
  712. remwho::calls    doremo    ,<#gn$who,#1,argbuf> ; /63/ remote who
  713.     return
  714.  
  715.  
  716.     .sbttl    Carry out the REMOTE command please
  717.  
  718. ;    DOREMOTE handles most generic commands that may have
  719. ;    a variable response, such as a simple ACK ("Y") with
  720. ;    the response in the data packet, an SINIT, or an "X"
  721. ;    packet.
  722.  
  723. doremo:    call    seropn            ; initialize the link
  724.     tst    r0            ; /BBS/ did it work?
  725.     bne    xit            ; /BBS/ nope, err msg dumped by ttyini
  726.     call    inista            ; /63/ init all the stats registers
  727.     movb    sentim    ,senpar+p.time    ; /63/ use send time-out
  728.     call    sinfo            ; /63/ must do before calling buffil!
  729.     clr    paknum            ; packet_number := 0  (must do this)
  730.     clr    numtry            ; clear the retry counter please
  731. ;;;    mov    sp    ,logini        ; /62/ force result msgs to a newline
  732.  
  733.     sub    #<ln$max*2>,sp        ; /62/ allocate a buffer please
  734.     mov    sp    ,r2        ; point to it
  735.     movb    @r5    ,(r2)+        ; /63/ the generic command to execute
  736.     mov    4(r5)    ,r1        ; get the first command argument
  737.     strlen    r1            ; get the length of it please
  738.     tochar    r0    ,(r2)+        ; followed by len of first arg
  739.     copyz    r1    ,r2 ,#ln$max    ; /63/ copy the arglist over please
  740.     cmp    2(r5)    ,#1        ; one or two arguments passed?
  741.     beq    20$            ; only one
  742. 10$:    tstb    (r2)+            ; two, so find the end so far
  743.     bne    10$            ; not yet
  744.     strlen    6(r5)            ; get the length of the second arg
  745.     dec    r2            ; point back to the null please
  746.     tochar    r0    ,(r2)+        ; and copy the new length over
  747.     copyz    6(r5)    ,r2 ,#ln$max    ; /63/ copy the second arg over now
  748. 20$:    mov    sp    ,r0        ; point back to the command buffer
  749.     calls    buffil    ,<r0,cmdbuf>    ; /63/ encoding the data as normal
  750.     add    #<ln$max*2>,sp        ; /62/ pop the local buffer
  751.  
  752. getres:    strlen    cmdbuf            ; /63/ get this way in case of retry
  753.     spack    #msg$gen,paknum,r0,cmdbuf ; /63/ send the command over please
  754. 10$:    rpack    r2 ,r3    ,#packet,#maxlng ; /62/ get the response from remote
  755.     mov    r3    ,paknum        ; save the packet number please
  756.     scan    r1    ,#remrsp    ; what to do with the response
  757.     asl    r0            ; word indexing
  758.     jsr    pc    ,@remdsp(r0)    ; and dispatch on the response
  759.     tst    r0            ; did it succeed?
  760.     beq    xit            ; /63/ yes
  761.     bit    #1    ,r0        ; /63/ no, is this an odd or even try?
  762.     beq    getres            ; /63/ only resend packets 2,4,6,...
  763.     br    10$            ; /63/ just listen for tries 1,3,5,...
  764.  
  765. xit:    clr    xmode            ; no extended reply stuff now
  766.     clr    xgottn            ; we don't have any "X" packets
  767.     clr    r0            ; don't pass error back to caller
  768.     jmp    clostt            ; /62/ close the link for now
  769.  
  770.     .save
  771.     .psect    $pdata
  772. remrsp:    .byte    msg$err    ,msg$nak,msg$snd,msg$ack,msg$tex,timout    ,badchk
  773.     .byte    0
  774.     .even
  775. remdsp:    .word    rem.$
  776.     .word    rem.e    ,rem.n    ,rem.s    ,rem.y    ,rem.x    ,rem.t    ,rem.ck
  777.     .restore
  778.  
  779. rem.ck:    mov    #rem.05    ,r2        ; /63/ checksum failed
  780.     br    rem.$$
  781. rem.n:    mov    #rem.06    ,r2        ; /63/ NAKed
  782.     br    rem.$$
  783. rem.t:    mov    #rem.07    ,r2        ; /63/ timed out
  784.     br    rem.$$
  785. rem.$:    mov    #rem.04    ,r2        ; /63/ invalid response
  786. rem.$$:    inc    numtry            ; add this try to the retry count
  787.     mov    numtry    ,r0        ; /63/ get number of tries so far
  788.     mov    #rem.d0    ,r1        ; /63/ where to write ascii copy
  789.     call    L10012            ; /63/ convert integer to ascii
  790.     clrb    @r1            ; /63/ null terminate ascii string
  791.     mov    initry    ,r0        ; /63/ now get the retry limit here
  792.     mov    #rem.d1    ,r1        ; /63/ this one's ascii copy goes here
  793.     call    L10012            ; /63/ convert it
  794.     clrb    @r1            ; /63/ and terminate it
  795. ;;;    clr    logini            ; /63/ already on a new line by now
  796.     calls    printm    ,<#5,#rem.02,#rem.d0,#rem.03,#rem.d1,r2> ; /63/
  797.     cmp    numtry    ,initry        ; /63/ been trying too hard?
  798.     blo    10$            ; /63/ not yet..
  799.     clr    r0            ; /63/ force an exit
  800.     jmp    m$retry            ; /63/ too many retries error
  801. 10$:    mov    numtry    ,r0        ; /63/ number of tries=what to do now
  802.     return
  803.  
  804. rem.x:    mov    sp    ,xmode        ; set a global flag for this
  805.     mov    sp    ,xgottn        ; we already have the "X" packet
  806.     calls    rec.sw    ,<#sta.fil>    ; yes, switch to receive data
  807.     clr    xmode            ; no longer want output to TT
  808.     clr    xgottn            ; we don't have any "X" packets
  809.     tst    r0            ; did the receive succeed?
  810.     beq    rem.tag            ; /62/ yes
  811. ;;;    mov    sp    ,logini        ; /62/ force following msg to newline
  812.     calls    error    ,<#1,#rem.01>    ; /63/ receive data failed
  813.     br    rem.xt            ; /63/
  814.  
  815. rem.s:    calls    rpar    ,<#packet,r2>    ; handle the sinit now
  816.     calls    spar    ,<#packet>    ; and send my init things over
  817.     spack    #msg$ack,paknum,sparsz,#packet
  818.     incm64    paknum            ; bump the packet number up mod 64
  819.     calls    rec.sw    ,<#sta.fil>    ; switch to get fileheader state
  820. rem.tag:.newline            ; /62/ shared .newline exit
  821. rem.xt:    clr    r0            ; /63/ or exit without one
  822.     return
  823.  
  824. rem.y:    mov    sp    ,rem.ack    ; /63/ set ACK rec'd flag for c$fin
  825.     tstb    packet            ; /63/ any data in the field?
  826.     beq    rem.xt            ; /63/ if not, just exit
  827.     calls    printm    ,<#2,#rem.ak,#packet> ; /62/ print the packet
  828.     br    rem.tag            ; /62/
  829.  
  830. rem.e:    calls    prerrp    ,<#packet>    ; /63/ print error text
  831.     br    rem.xt            ; /63/
  832.  
  833.  
  834.     .sbttl    Initialize for an extended reply to a generic command
  835.  
  836. ;    Here's where we send an "X" packet back to the requesting Kermit
  837. ;    to  say that we are going to send an extended reply to it.  This
  838. ;    reply takes the form of a  normal file transfer but we will want
  839. ;    it to be printed on the user's terminal rather than go to a disk
  840. ;    file.  Thus the use of the "X" packet to start things off.
  841.  
  842. xreply:    strcpy    #srcnam    ,r0        ; /62/ copy the file name to be sent
  843.     clrb    filnam            ; /38/ ensure cleared out
  844.     tstb    srcnam            ; /38/ is there really a file?
  845.     beq    10$            ; /38/ no, ignore lookup then
  846.     clr    index            ; /62/ wildcard file number := 0
  847.     call    getnxt            ; go do a directory lookup please
  848.     tst    r0            ; well, did the lookup work out?
  849.     bne    20$            ; /62/ no, getnxt has sent error pak
  850. 10$:    mov    sp    ,xmode        ; flag this is an extended reply
  851.     calls    sensw    ,<#sta.fil>    ; go send the extended reply text
  852. 20$:    clr    xmode            ; no longer extended reply mode
  853.     clr    xgottn            ; we don't have any "X" packets
  854.     clr    r0            ; success
  855.     textsrc                ; /38/ reset to normal file I/O
  856.     return
  857.  
  858.  
  859.     .sbttl    Open link and flush NAKs
  860.  
  861. seropn:    save    <r1>
  862.     call    opentt            ; open the link for a server command
  863.     tst    r0            ; did it work?
  864.     bne    20$            ; /BBS/ no, err msg dumped by ttyini
  865.     call    cantyp            ; flush any accumulated NAKs
  866. 10$:    calls    xbinread,<#-1>        ; /63/ read with no wait to flush
  867.     tst    r0            ; /63/ any possible junk in buffer
  868.     beq    10$            ; /63/ loop until nothing remains
  869.     clr    r0            ; /63/ no error possible here
  870. 20$:    unsave    <r1>
  871.     return
  872.  
  873.  
  874.     .sbttl    Server init
  875.  
  876. sinfo:    save                ; save ALL registers please
  877.     bit    #log$pa    ,trace        ; /62/ logging packets this time?
  878.     beq    10$            ; /62/ no
  879.     calls    putrec    ,<#0,#0,#lun.lo> ; /62/ ya, put newline into log file
  880.     tst    r0            ; /62/ did it work?
  881.     beq    10$            ; /62/ ya
  882.     call    logerr            ; /62/ no, handle the error
  883. 10$:    mov    sp    ,inprogress    ; /63/ flag packets being exchanged
  884.     clr    numtry            ; send info packets before any
  885.     clr    paknum            ; extended server response please
  886.     movb    #msg$ser,-(sp)        ; packet type "I"
  887.     call    .sinit            ; do it
  888.     unsave                ; restore ALL registers now
  889.     return
  890.  
  891.     .end
  892.