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