home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pdp11 / k11ser.mac < prev    next >
Text File  |  2020-01-01  |  29KB  |  1,101 lines
  1.     .title    k11ser    server for KERMIT-11
  2.     .ident    /8.0.01/
  3.  
  4.  
  5.  
  6. ;    Brian Nelson  22-Dec-83  12:16:59
  7. ;
  8. ;    This is the server module for KERMIT-11
  9. ;    it also has the modules to talk to a remote kermit
  10.  
  11.  
  12.  
  13.  
  14.     .if ndf, K11INC
  15.     .ift
  16.     .include    /IN:K11MAC.MAC/
  17.     .include    /IN:K11DEF.MAC/
  18.     .include    /IN:K11CDF.MAC/
  19.     .endc
  20.  
  21.     .iif ndf    ,k11inc    ,.error    ; missing INCLUDE for K11MAC.MAC
  22.     .enabl    gbl
  23.  
  24.  
  25.  
  26.     rodata
  27.  
  28. notimp:    .asciz    /?Kermit-11  Unimplemented server command/
  29. notgen:    .asciz    /?Kermit-11  Unimplemented server generic command/
  30. kertmp:    .asciz    /KERMIT.TMP/
  31. invarg:    .asciz    /?Kermit-11  Invalid arguments for remote server command/
  32. crlf:    .byte    cr,lf,0
  33. fubar    =    0
  34.     .even
  35.  
  36.     global    <null>
  37.  
  38.     code
  39.  
  40.  
  41.  
  42.     .sbttl    call the server
  43.  
  44.  
  45.  
  46. c$serv::$name    <SER>            ; allow patching this out (why??)
  47.     clr    notatt            ; assume attached
  48.     tstb    @argbuf            ; if nothing for arg, do normal server
  49.     beq    20$            ; ok, do normal server thing
  50.     calls    getcm0    ,<argbuf,#serlst>; no, check for server cmd argument
  51.     tst    r0            ; did we find a valid one
  52.     bmi    110$            ; no
  53.     jsr    pc    ,@r1        ; yes, process it
  54.     tst    r0            ; did this work?
  55.     bne    100$            ; no, exit please
  56.  
  57. 20$:    clr    mcrcmd            ; always allow remote FIN command
  58.     tst    notatt            ; are we attached today?
  59.     bne    30$            ; no
  60.     tst    infomsg            ; /41/ Should we be verbose today?
  61.     beq    30$            ; /41/ no
  62.     print    #sertxt            ; dump a message out please
  63. 30$:    call    opentt            ; get the line open please
  64.     direrr    r0            ; print any errors out
  65.     calls    cantyp    ,<#ttname,#lun.ti>; dump garbage perhaps
  66.     call    server            ; and do it
  67.     call    clostt            ; we came back ?
  68.     clr    notatt            ; assume attached now
  69. 100$:    clr    r0
  70.     return                ; ok
  71.  
  72.  
  73. 110$:    message    <Invalid SERVER subcommand>,cr
  74.     return
  75.  
  76.     .enabl    lsb
  77.  
  78. sr$det:    tstb    ttdial            ; insure a SET LINE command was done
  79.     beq    110$            ; no, thats an error please
  80.     message    <Server detaching from TI:>,cr
  81.     call    detach            ; detach from the current TI:
  82.     tst    r0            ; did this work ok ?
  83.     bne    90$            ; no
  84.     mov    sp    ,notatt        ; no longer attached to ti:
  85.     clr    r0
  86.     br    100$
  87. 90$:    direrr    r0            ; say why please
  88. 100$:    return
  89.  
  90. 110$:    message    <You must use the SET LINE command before detaching the server>
  91.     message
  92.     mov    sp    ,r0
  93.     return
  94.  
  95.     .dsabl    lsb
  96.  
  97.  
  98.     $cmglob    =    0
  99.  
  100.     command    serlst    ,DETACH    ,3    ,sr$det
  101.     command    serlst
  102.  
  103.  
  104.     global    <detach    ,lun.ti    ,notatt    ,server>
  105.  
  106.  
  107.     .save
  108.     .psect    $pdata
  109.  
  110. sertxt:
  111.  
  112. .ascii #Kermit Server running on PDP-11 host. Please type your escape sequence#
  113. .byte  cr,lf
  114. .ascii #to return  to your local machine.  Shut down the server by  typing the#
  115. .byte  cr,lf
  116. .asciz #Kermit BYE command on your local machine.#<cr><lf>
  117.  
  118.     .even
  119.     .restore
  120.  
  121.  
  122.  
  123.  
  124.     .sbttl    the main server loop
  125.     code
  126.  
  127.  
  128. server::mov    remote    ,-(sp)        ; save the local/remote flag
  129.     mov    sp    ,remote        ; if a server we are always remote
  130.     mov    sp    ,inserv        ; global flag to say we are a server
  131.  
  132. 10$:    clr    paknum            ; packetnumber := 0
  133.     clr    numtry            ; number_of_retrys := 0
  134.     clr    oldtry            ; oldtries := 0
  135.     clr    cccnt            ; /38/ clear control C flag
  136.     textsrc                ; /38/ reset to normal file i/o
  137.     mov    #defchk    ,chktyp        ; checksum_type := type_1
  138.     mov    #1    ,chksiz        ; checksum_len  := 1
  139.     mov    $image    ,image        ; insure correct default is set
  140.     call    fixchk            ; sendpar_checktype := set_checktype
  141.     mov    serwai    ,sertim        ; /41/ set a new timeout please
  142.     rpack    r2,r3,#packet        ; loop forever
  143.     clr    sertim            ; normal timeouts now
  144.  
  145.     scan    r1    ,#sercom    ; is the generic command type
  146.     asl    r0            ; index into dispatch table
  147.     jsr    pc    ,@serdsp(r0)    ; simple
  148.  
  149.     tst    r0            ; done flag ?
  150.     beq    10$            ; next server command please
  151. 100$:    calls    suspend    ,<#2>        ; sleep a moment please
  152.     clr    inserv            ; no longer a server
  153.     mov    (sp)+    ,remote        ; save the local/remote flag
  154.     return
  155.  
  156.  
  157.     dispat    basedsp=serdsp    ,baseval=sercom    ,default=serv.$
  158.  
  159.     dispat    MSG$SND        ,serv.s    ; server init for receive a file
  160.     dispat    MSG$RCV        ,serv.r    ; send a file
  161.     dispat    MSG$GENERIC    ,serv.g    ; do a server command
  162.     dispat    MSG$SER        ,serv.i    ; do a server sinit
  163.     dispat    TIMOUT        ,serv$$    ; we timed out
  164.     dispat    BADCHK        ,serchk    ; a fubar checksum
  165.     dispat    MSG$NAK        ,serv$$    ; a NAK this time
  166.     dispat    MSG$ACK        ,serv$$    ; things are ok now
  167.     dispat    MSG$COMMAND    ,serv.c    ; a host command
  168.     dispat    MSG$ERROR    ,sernop    ; ignore 'E' packets from remote
  169.     dispat
  170.  
  171.     global    <badchk    ,numtry    ,oldtry    ,paknum    ,sertim>
  172.     global    <chksiz    ,chktyp    ,inserv    ,fixchk    ,$image>
  173.  
  174.  
  175.  
  176.     .sbttl    routines for server
  177.  
  178.  
  179. serv.$:    strlen    #notimp
  180.     spack    #MSG$ERROR,paknum,r0,#notimp ; ignore unrecognized packet type
  181.     clr    r0            ; not done yet
  182.     return
  183.  
  184.  
  185. serv$$:    call    serchk            ; timeout, send a NAK please
  186. sernop:    clr    r0            ; not yet done
  187.     return                ; ignore timeouts, ACKS and NAKS
  188.  
  189.  
  190. serchk:    mov    r3    ,paknum        ; nak checksum errors
  191.     spack    #MSG$NAK,paknum        ; send the NAK out please
  192.     clr    r0            ; we are not done
  193.     return
  194.  
  195.  
  196. serv.i:    mov    r3    ,paknum        ; we got an init packet. respond in
  197.     calls    rpar    ,<#packet,r2>    ; kind please
  198.     calls    spar    ,<#packet>    ; get our parameters and send them to
  199.     spack    #MSG$ACK,paknum,sparsz,#packet; the other kermit
  200.     call    inirepeat        ;
  201.     clr    r0            ; not done
  202.     return                ; bye
  203.  
  204.     global    <inirepeat>
  205.  
  206.  
  207. serv.s:    mov    pauset    ,oldpau        ; save the old pause time please
  208.     call    throtl            ; and throttle the line speed
  209.     mov    r3    ,paknum        ; got a SINIT, initialize packet number
  210.     calls    rpar    ,<#packet,r2>    ; store there send init info away
  211.     calls    spar    ,<#packet>    ; and send them ours for the ACK
  212.     spack    #MSG$ACK,paknum,sparsz,#packet
  213.     call    inirepeat        ; do repeat initialization
  214.     mov    numtry    ,oldtry        ; save the retry count
  215.     clr    numtry            ; retrycount := 0
  216.     incm64    paknum            ; paknum := ( paknum+1 ) mod 64
  217.     calls    rec.sw    ,<#STA.FIL>    ; and get set to receive a filename
  218.     clr    r0            ; not done
  219.     mov    oldpau    ,pauset        ; restore old pause time
  220.     return                ; next server command please
  221.  
  222.  
  223.  
  224. serv.r:    calls    bufunp    ,<#packet,#srcnam> ; /53/
  225.     clrb    srcnam(r1)        ; /53/
  226.     calls    fixwild    ,<#srcnam>    ; change % to ?
  227.     clr    index            ; first file in directory please
  228.     call    getnxt            ; get the first filename please
  229.     tst    r0            ; did it work ?
  230.     bne    100$            ; no. Getnxt will send the error pak
  231.     calls    sen.sw    ,<#STA.SIN>
  232. 100$:    clr    r0            ; not done
  233.     return
  234.  
  235.  
  236.     .enabl    lsb
  237.  
  238. serv.c:    call    cretmp            ; create the temp file please
  239.     bcs    100$            ; oops
  240.     calls    sercmd    ,<#packet,#lun.ou>; it worked
  241.     cmpb    r0    ,#377        ; normal exit on KMON wait?
  242.     beq    10$            ; yes
  243.     tst    r0            ; zero (?)
  244.     beq    10$            ; yes
  245.     calls    syserr    ,<r0,#errtxt>    ; no, send the error over
  246.     strlen    #errtxt            ; the length
  247.     spack    #MSG$ERROR,paknum,r0,#errtxt ; ignore unrecognized packet type
  248.     call    clotmp            ; no, send error over
  249.     br    100$            ; bye
  250. 10$:    call    clotmp            ; close it and send the file over
  251.     mov    #kertmp    ,r0        ; as a text reply
  252.     call    xreply
  253. 100$:    clr    r0
  254.     return
  255.  
  256.     .save
  257.     .psect    $PDATA    ,D
  258. 200$:    .asciz    /Spawned job failed due to timeout or TT read wait/<cr><lf>
  259.     .even
  260.     .restore
  261.     .dsabl    lsb
  262.  
  263.  
  264. serv.g:    sub    #200    ,sp        ; /53/ Make a temp copy of data
  265.     mov    sp    ,r2        ; /53/ Point to it
  266.     STRCPY    r2    ,#packet    ; /53/ Copy it
  267.     calls    bufunp    ,<r2,#packet>    ; /53/ Undo it (with repeats)
  268.     add    #200    ,sp        ; /53/ Pop buffer
  269.     movb    packet+0,r2        ; get the first data byte which
  270.     scan    r2,#gencom        ; is the generic command type
  271.     asl    r0            ; index into dispatch table
  272.     jsr    pc    ,@gendsp(r0)    ; simple
  273.     return
  274.  
  275.  
  276.     dispat    basedsp=gendsp    ,baseval=gencom    ,default=gen.$
  277.  
  278.     dispat    GN$LOGIN    ,gen.i
  279.     dispat    GN$EXIT        ,gen.f
  280.     dispat    GN$CONNECT    ,gen.c
  281.     dispat    GN$BYE        ,gen.l
  282.     dispat    GN$DIRECTORY    ,gen.d
  283.     dispat    GN$DISK        ,gen.u
  284.     dispat    GN$DELETE    ,gen.e
  285.     dispat    GN$SUBMIT    ,gen.$
  286.     dispat    GN$WHO        ,gen.w
  287.     dispat    GN$SEND        ,gen.$
  288.     dispat    GN$HELP        ,gen.h
  289.     dispat    GN$QUERY    ,gen.$
  290.     dispat    GN$RENAME    ,gen.r
  291.     dispat    GN$COPY        ,gen.k
  292.     dispat    GN$PRINT    ,gen.$
  293.     dispat    GN$PROGRAM    ,gen.$
  294.     dispat    GN$JOURNAL    ,gen.$
  295.     dispat    GN$VARIABLE    ,gen.$
  296.     dispat    GN$TYPE        ,gen.t
  297.     dispat
  298.  
  299.  
  300.     global    <getnxt    ,index    ,numtry    ,oldtry    ,paknum>
  301.     global    <srcnam    ,sparsz    ,pauset    ,oldpau    ,throtl>
  302.  
  303.  
  304.  
  305.     .sbttl    generic kermit routines
  306.  
  307.  
  308. gen.$:    strlen    #notgen            ; NO-OP for unimplemented generic
  309.     spack    #MSG$ERROR,paknum,r0,#notgen ; send an error packet back please
  310.     clr    r0            ; not done
  311.     return
  312.  
  313.  
  314. gen.f:    spack    #MSG$ACK,paknum        ; send a simple ACK
  315.     clr    r0            ; /45/ May want to stay in server
  316.     tst    srvprot            ; /45/ Do we REALLY want to do this?
  317.     bne    100$            ; /45/ No
  318.     call    clostt            ; close the terminal up and exit
  319.     mov    sp    ,r0        ; all done, return to command mode
  320. 100$:    return
  321.  
  322.  
  323.     .enabl    lsb            ; /54/ I/D space
  324.  
  325. gen.l:    call    quochk            ; see if they will be able to logout
  326.     tst    r0            ; well ?
  327.     bne    10$            ; not likely, but try anyway
  328.     tst    srvprot            ; /45/ Is the server protected?
  329.     beq    5$            ; /45/ No
  330.     strlen    #210$            ; /45/ Yes, tell them what we did
  331.     spack    #MSG$ERR,paknum,r0,#210$; /45/ Ie, DISCONNECT but no LOGOUT
  332.     calls    suspend    ,<#2,#0>    ; /45/ Insure response gets through
  333.     calls    ttyhang    ,<#ttname>    ; /45/ Drop the line please
  334.     br    100$            ; /45/ Now do it
  335. 5$:    spack    #MSG$ACK,paknum        ; assume we can log out
  336. 10$:    call    clostt            ; close the terminal please
  337.     bit    #log$op    ,trace        ; a logfile open now ?
  338.     beq    20$            ; no
  339.     calls    close    ,<#lun.lo>    ; yes, close it please
  340. 20$:    call    logout            ; and log out of the system
  341.     call    opentt            ; get the terminal back
  342.     strlen    #200$            ; logout failed
  343.     spack    #MSG$ERROR,paknum,r0,#200$ ; send an error message back then
  344. 100$:    clr    r0            ; not yet done
  345.     return                ; oops
  346.  
  347.     .save
  348.     .psect    $PDATA    ,D
  349.     .enabl    lc
  350. 200$:    .asciz    /Logout failed - Quota exceeded/
  351. 210$:    .asciz    /Server disconnected and still logged in/
  352.     .even
  353.     .restore
  354.     .dsabl    lsb
  355.  
  356.  
  357. gen.u:    sub    #120    ,sp        ; allocate a buffer for string
  358.     mov    sp    ,r1        ; and point to it
  359.     calls    dskuse    ,<r1>        ; get the string to print
  360.     strlen    r1            ; get the string length
  361.     spack    #MSG$ACK,paknum,r0,r1    ; and send the data back
  362.     add    #120    ,sp        ; and exit
  363.     clr    r0            ; not yet done
  364.     return
  365.  
  366.  
  367.     .enabl    lsb            ; /54/ I/D space
  368.  
  369. gen.c:    mov    #packet+1,r1        ; get the packet address
  370.     mov    #defdir    ,r4        ; /59/
  371.     clrb    @r4            ; /59/ Assume clearing defdir
  372.     unchar    (r1)+    ,r2        ; get the size of the data
  373.     beq    90$            ; nothing to do ?
  374.     mov    r1    ,-(sp)        ; /59/ Save source address
  375. 10$:    movb    (r1)+    ,(r4)+        ; /59/ Copy dir name, and do not
  376.     sob    r2    ,10$        ; /59/ include password length and
  377.     mov    (sp)+    ,r1        ; /59/ actual password, if present
  378.     sub    #140    ,sp        ; allocate a buffer
  379.     mov    sp    ,r2        ; point to the buffer
  380.     strcpy    r2    ,#110$        ; build up a message
  381.     strcat    r2    ,r1        ; add the directory name in
  382.     strlen    r2            ; get the total length
  383.     spack    #MSG$ACK,paknum,r0,r2    ; and sent the ack message
  384.     add    #140    ,sp        ; pop buffer
  385.     br    100$            ; and exit
  386. 90$:    strlen    #120$            ; Say we cleared it
  387.     spack    #MSG$ACK,paknum,r0,#120$; error text to send
  388. 100$:    clr    r0            ; not done
  389.     return
  390.  
  391.  
  392.     .save
  393.     .psect    $PDATA    ,D
  394. 110$:    .asciz    /Default directory set to /
  395. 120$:    .asciz    /Default directory cleared/ ; /58/ Changed as per the frog book
  396.     .even
  397.     .restore
  398.     .dsabl    lsb
  399.  
  400.  
  401.  
  402.  
  403.     .sbttl    handle the request for erase (delete) and directory
  404.  
  405. gen.e:    mov    #packet+1,r1        ; get the packet address
  406.     unchar    (r1)+    ,r2        ; get the arguement length
  407.     bne    10$            ; non zero
  408.     clrb    @r1            ; zero, make the string null
  409. 10$:    call    cretmp            ; create temporary log file
  410.     bcs    100$            ; oops
  411.     calls    delete    ,<r1,#lun.ou>    ; do it
  412.     save    <r0>            ; save the error code please
  413.     call    clotmp            ; close the temp file up
  414.     unsave    <r0>            ; restore delete's error code
  415.     tst    r0            ; did it work ?
  416.     beq    80$            ; yes
  417.     call    generr            ; no, send the RMS error code over
  418.     br    100$
  419.  
  420. 80$:    dec    r1            ; only delete one file ?
  421.     bne    90$            ; no, set up for extended reply
  422.     copyz    #<packet+2>,#errtxt    ; a simple reply for one file deleted
  423.     strlen    #errtxt            ; get the length so far
  424.     add    #errtxt    ,r0        ; point to the end of it please
  425.     copyz    #delmsg    ,r0        ; and copy some informative text
  426.     strlen    #errtxt            ; get the total length now
  427.     spack    #MSG$ACK,paknum,r0,#errtxt ; and send a simple ACK packet
  428.     br    100$            ; bye
  429.  
  430. 90$:    mov    #kertmp    ,r0        ; send over the delete log file
  431.     call    xreply
  432. 100$:    clr    r0            ; not done with the server yet
  433.     return
  434.  
  435.     .Save
  436.     .Psect    $Pdata    ,D
  437. delmsg:    .asciz    / deleted/        ; some text to send
  438.     .even
  439.     .Restore
  440.  
  441.  
  442. ;    REMOTE DIRECTORY
  443. ;
  444. ;    Modified 07-Nov-85 by BDN to not use a work file for storing
  445. ;    the results of the lookups. Much faster than old way.
  446.  
  447. gen.d:    mov    #packet+1,r1        ; /38/ get the packet address
  448.     unchar    (r1)+    ,r2        ; /38/ get the arguement length
  449.     bne    5$            ; /38/ something was there
  450.     clrb    @r1            ; /38/ nothing was there, insure .asciz
  451. 5$:    calls    fixwild    ,<r1>        ; /38/ convert % to ? for RSTS/E only
  452.     calls    sdirini    ,<r1>        ; /38/ Init directory lookup and 
  453.     tst    r0            ; /38/ preload sdodir's buffer.
  454.     beq    10$            ; /38/ Send error packet on any error
  455.     call    generr            ; /38/ Makes interfacing to BUFFIL
  456.     br    100$            ; /38/ a bit simpler
  457. 10$:    mov    #sdodir    ,getcroutine    ; /38/ Stuff address of get_nextchar
  458.     mov    #null    ,r0        ; /38/ and flag we are NOT using a file
  459.     call    xreply            ; /38/ Do the extended reply now
  460. 100$:    clr    r0            ; /38/ cleared
  461.     return                ; /38/ and exit
  462.  
  463.  
  464. ;    mov    #packet+1,r1        ; get the packet address
  465. ;    unchar    (r1)+    ,r2        ; get the arguement length
  466. ;    bne    5$            ; something was there
  467. ;    clrb    @r1            ; nothing was there, insure .asciz
  468. ;5$:    call    cretmp            ; create the temp file please
  469. ;    bcs    100$            ; oops
  470. ;    calls    fixwild    ,<r1>        ; change % to ?
  471. ;    calls    dodir    ,<r1,#lun.ou>    ; it worked
  472. ;    call    clotmp            ; close it and send the file over
  473. ;    mov    #kertmp    ,r0        ; as a text reply
  474. ;    call    xreply
  475. ;100$:    clr    r0
  476. ;    return
  477.  
  478.  
  479.  
  480.  
  481.  
  482.  
  483.     .sbttl    do remote help command
  484.  
  485.  
  486. gen.h:    textsrc    #htxt            ; /38/ use memory resident
  487.     mov    #null    ,r0        ; /38/ for this extended response
  488.     call    xreply            ; /38/
  489.     clr    r0            ; /38/ success
  490.     return                ; /38/ exit
  491.  
  492.     .save
  493.     .psect    $Pdata    ,D
  494. htxt:    .ascii    /The following commands are available for the Kermit-11/<cr><lf>
  495.     .ascii    /server.  To avoid ambiguity with local Kermit commands/<cr><lf>
  496.     .ascii    /some of the  server commands will  need to be prefixed/<cr><lf>
  497.     .ascii    /with the REMOTE keyword./<cr><lf>
  498.     .byte    cr,lf
  499.     .ascii    /BYE        Logout Kermit-11/<cr><lf>
  500.     .ascii    /REMOTE COPY    Copy one file to another/<cr><lf>
  501.     .ascii    /REMOTE CWD    Change default directory/<cr><lf>
  502.     .ascii    /REMOTE DIR     Prints the directory out/<cr><lf>
  503.     .ascii    /REMOTE DISK    Prints  available  space/<cr><lf>
  504.     .ascii    /REMOTE ERASE    Deletes  the filename(s)/<cr><lf>
  505.     .ascii    /FINISH        Exits a Kermit-11 server/<cr><lf>
  506.     .ascii    /GET         Sends  the filename(s)/<cr><lf>
  507.     .ascii    /REMOTE HELP    Prints this  help text/<cr><lf>
  508.     .ascii    /REMOTE HOST    Execute a host command/<cr><lf>
  509.     .ascii    /REMOTE LOGIN    Login.  RSTS V9.x only/<cr><lf>
  510.     .ascii    /REMOTE RENAME    Rename old file to new/<cr><lf>
  511.     .ascii    /REMOTE SPACE    Prints the disk  space/<cr><lf>
  512.     .ascii    /REMOTE TYPE    Prints the filename(s)/<cr><lf>
  513.     .ascii    /REMOTE WHO    Shows users logged  in/<cr><lf>
  514.     .byte    cr,lf,0
  515.     .even
  516.     .restore
  517.  
  518.     global    <clostt    ,exit    ,logout    ,opentt    ,paknum    ,quochk>
  519.     global    <lun.lo    ,trace>
  520.  
  521.  
  522.  
  523.  
  524.  
  525.     .sbttl    the remote type command and who commands
  526.     .enabl    lsb
  527.  
  528.  
  529.     
  530. gen.t:    mov    #packet+1,r1        ; get the packet address
  531.     tstb    @r1            ; anything there ?
  532.     beq    5$            ; no, thats an error
  533.     unchar    (r1)+    ,r2        ; get the arguement length
  534.     bne    10$            ; something was there
  535. 5$:    calls    error    ,<#1,#200$>    ; have to have something to type
  536.     br    100$            ; bye
  537. 10$:    mov    r1    ,r0        ; send the file over now
  538.     call    xreply            ; simple to do
  539. 100$:    clr    r0            ; not done yet
  540.     return
  541.  
  542.     .save
  543.     .psect    $Pdata,d
  544. 200$:    .asciz    /I need a filename to TYPE/
  545.     .even
  546.     .restore
  547.     .dsabl    lsb
  548.     .enabl    lsb
  549.  
  550. gen.w:    call    cretmp            ; get the temp file created  first
  551.     bcs    100$            ; oops
  552.     calls    systat    ,<#lun.ou>    ; dump the systat out to disk now.
  553.     tst    r0            ; did it work ?
  554.     beq    10$            ; yes
  555.     calls    error    ,<#1,#200$>    ; no, send an error packet over
  556.     call    clotmp            ; insure temp file is closed
  557.     br    100$            ; bye
  558. 10$:    call    clotmp            ; close the temp file now
  559.     mov    #kertmp    ,r0        ; and send an extended reply
  560.     call    xreply            ; simple to do
  561. 100$:    clr    r0            ; not done yet
  562.     return                ; bye
  563.  
  564.     .save
  565.     .psect    $Pdata,d
  566. 200$:    .asciz    /SYSTAT failed/
  567.     .even
  568.     .restore
  569.     .dsabl    lsb
  570.  
  571.  
  572.     .sbttl    do the server copy and rename functions
  573.     .enabl    lsb
  574.  
  575. gen.i:    sub    #120    ,sp
  576.     mov    #120$    ,r3
  577.     call    get2ar
  578.     bcs    90$
  579.     mov    sp    ,r3
  580.     calls    login    ,<r1,r2,r3>    ; 1=uic,2=password,3=addr(msgtext)
  581.     tst    r0            ; did this one work ?
  582.     bne    90$            ; no
  583.     strlen    #110$            ; an ack message
  584.     spack    #MSG$ACK,paknum,r0,#110$; send it back
  585.     br    100$            ; and exit please
  586.  
  587. 90$:    calls    error    ,<#1,r3>    ; invalid arguments
  588.  
  589. 100$:    clr    r0            ; no errros
  590.     add    #120    ,sp        ; pop stack and exit
  591.     return                ; exit
  592.  
  593.     .save
  594.     .psect    $Pdata,d
  595. 110$:    .asciz    /Login successful/
  596. 120$:    .asciz    /Missing password or UIC (PPN)/
  597.     .even
  598.     .restore
  599.     .dsabl    lsb
  600.     .enabl    lsb
  601.  
  602. gen.k:    call    get2ar            ; get pointers to 'from' and 'to'
  603.     bcs    90$            ; oops, send an error packet over
  604.     calls    copy    ,<r1,r2,#-1>    ; copy the file now
  605.     tst    r0            ; did it work out ok ?
  606.     bne    80$            ; no
  607.     sub    #50    ,sp        ; yes, formulate a simple ack
  608.     mov    sp    ,r2        ; response telling them how many
  609.     deccvt    r1,r2,#5        ; blocks that we copied over
  610.     add    #5    ,r2        ; point past the block count
  611.     copyz    #200$    ,r2        ; copy a message and then ack it
  612.     mov    sp    ,r2        ; point back to the start of buffer
  613.     strlen    r2            ; get the string length now
  614.     spack    #MSG$ACK,paknum,r0,r2    ; send the ack over
  615.     add    #50    ,sp        ; pop the local buffer and exit
  616.     br    100$            ; bye
  617.  
  618. 80$:    call    generr            ; error, send RMS (sys) error text
  619.     br    100$            ; bye
  620.  
  621. 90$:    calls    error    ,<#1,#invarg>    ; invalid arguments
  622.  
  623. 100$:    clr    r0            ; exit
  624.     return                ; bye
  625.  
  626.     .Save
  627.     .Psect    $Pdata,d
  628. 200$:    .asciz    / blocks copied/
  629.     .even
  630.     .restore
  631.     .dsabl    lsb
  632.     .enabl    lsb
  633.  
  634.  
  635. ;    RENAME
  636.  
  637. gen.r:    call    get2ar            ; get pointers to 'from' and 'to'
  638.     bcs    90$            ; oops, send an error packet over
  639.     calls    rename    ,<r1,r2,#-1>    ; rename the file(s) now
  640.     tst    r0            ; did it work out ok ?
  641.     bne    80$            ; no
  642.     sub    #50    ,sp        ; yes, formulate a simple ack
  643.     mov    sp    ,r2        ; response telling them how many
  644.     deccvt    r1,r2,#5        ; number of files that were renamed
  645.     add    #5    ,r2        ; point past the block count
  646.     copyz    #200$    ,r2        ; copy a message and then ack it
  647.     mov    sp    ,r2        ; point back to the start of buffer
  648.     strlen    r2            ; get the string length now
  649.     spack    #MSG$ACK,paknum,r0,r2    ; send the ack over
  650.     add    #50    ,sp        ; pop the local buffer and exit
  651.     br    100$            ; bye
  652.  
  653. 80$:    call    generr            ; error, send RMS (sys) error text
  654.     br    100$            ; bye
  655.  
  656. 90$:    calls    error    ,<#1,#invarg>    ; invalid arguments
  657.  
  658. 100$:    clr    r0            ; exit
  659.     return                ; bye
  660.  
  661.     .save
  662.     .psect    $Pdata,d
  663. 200$:    .asciz    / file(s) renamed/
  664.     .even
  665.     .restore
  666.     .dsabl    lsb
  667.  
  668.  
  669.  
  670.     .sbttl    create the server temp file
  671.     .enabl    lsb
  672.  
  673. cretmp:    save    <r1>
  674.     mov    #errtxt    ,r0        ; must fill in defdir also
  675.     mov    #defdir    ,r1        ; default directory string
  676. 10$:    movb    (r1)+    ,(r0)+        ; copy it over please
  677.     bne    10$            ; not the end of it yet
  678.     dec    r0            ; end, backup over the null
  679.     mov    #kertmp    ,r1        ; and copy the filename over please
  680. 20$:    movb    (r1)+    ,(r0)+        ; do it
  681.     bne    20$            ; not the end yet
  682.     calls    create    ,<#errtxt,#lun.ou,#text>
  683.     tst    r0            ; did the create for the temp
  684.     beq    100$            ; file work
  685.     save    <r0>            ; save the error number
  686.     calls    syserr    ,<r0,#errtxt>    ; no
  687.     calls    error    ,<#2,#200$,#errtxt>; get the error text and send it
  688.     unsave    <r0>            ; keep the RMS error number around
  689.     sec                ; say it did not work
  690.     br    110$            ; bye
  691.  
  692. 100$:    clr    r0            ; clc and clear r0 both
  693.     clc
  694. 110$:    unsave    <r1>
  695.     return
  696.  
  697.     .save
  698.     .psect    $Pdata,d
  699. 200$:    .asciz    /Can't create KERMIT.TMP /
  700.     .even
  701.     .restore
  702.     .dsabl    lsb
  703.  
  704. clotmp:    calls    close    ,<#lun.ou>
  705.     clr    r0
  706.     return
  707.  
  708.  
  709.  
  710. generr:    calls    syserr    ,<r0,#errtxt>    ; send a system error E packet over
  711.     calls    error    ,<#1,#errtxt>    ; simple to do
  712.     clr    r0            ; assume no errors and exit
  713.     return
  714.  
  715.  
  716.  
  717.  
  718.     .sbttl    get pointer for a two argument server command
  719.  
  720. ;    input:    packet    what we just read as a server
  721. ;    output:    r1    first  argument address (in 'packet'), .asciz
  722. ;        r2    second argument address (in 'packet'), .asciz
  723. ;        carry    set on missing arg, clear if all is well and good
  724. ;
  725. ;    assumptions: the packet received is .asciz
  726.  
  727.  
  728. get2ar:    save    <r3,r4>            ; save work registers please
  729.     mov    #packet+1,r3        ; get the address of our parameters
  730.     tstb    @r3            ; a null. if so, thats an error
  731.     beq    90$            ; exit with carry set
  732.     unchar    (r3)+    ,r4        ; get the length of the first arg
  733.     beq    90$            ; a null string, exit with error
  734.     mov    r3    ,r1        ; not null, point to the first one
  735.     add    r4    ,r3        ; point to the length field for 2nd
  736.     tstb    @r3            ; must not be null or zero
  737.     beq    90$            ; null, missing second argument
  738.     unchar    (r3)+    ,r4        ; get the length of the last field
  739.     beq    90$            ; nothing is there, abort please
  740.     mov    r3    ,r2        ; return a pointer to the second arg
  741.     clrb    -(r3)            ; insure the first argument is .asciz
  742.     clc                ; success at last
  743.     br    100$            ; exit please
  744.  
  745. 90$:    sec                ; failure, to try again someday
  746. 100$:    unsave    <r4,r3>            ; pop the registers we used and exit
  747.     return                ; good bye
  748.  
  749.  
  750.  
  751.  
  752.  
  753.     .sbttl    talk to a remote server
  754.     .enabl    lsb
  755.  
  756. remfin::clr    paknum            ; packetnumber := 0
  757.     call    seropn            ; get the link line intialzied
  758.     spack    #MSG$GENERIC,paknum,#1,#200$ ; send a generic F command
  759.     rpack    r2,r3,#packet        ; get an ack for it please
  760.     cmpb    r1    ,#MSG$ACK    ; did the server like it
  761.     beq    100$            ; yes
  762.     calls    error    ,<#1,#210$>    ; no, say so
  763. 100$:    call    clostt            ; close up the remote link now
  764.     return                ; and back please
  765.  
  766.  
  767.     .save
  768.     .psect    $Pdata,d
  769. 200$:    .byte    GN$EXIT,0
  770. 210$:    .asciz    /Can't get the remote KERMIT to FINISH/<cr><lf>
  771.     .even
  772.     .restore
  773.     .dsabl    lsb
  774.     .enabl    lsb
  775.  
  776. rembye::clr    paknum            ; packetnumber := 0
  777.     call    seropn            ; get the link line intialzied
  778.     spack    #MSG$GENERIC,paknum,#1,#200$ ; send a generic L command
  779.     rpack    r2,r3,#packet        ; get an ack for it please
  780.     cmpb    r1    ,#MSG$ACK    ; did the server like it
  781.     beq    100$            ; yes
  782.     cmpb    r1    ,#MSG$ERROR    ; what about an error packet
  783.     bne    10$            ; no
  784.     calls    error    ,<#1,#packet>    ; yes, print the response
  785.     br    100$            ; exit
  786. 10$:    calls    error    ,<#1,#210$>    ; other error
  787. 100$:    call    clostt            ; close up the remote link now
  788.     return
  789.  
  790.  
  791.     .save
  792.     .psect    $Pdata,d
  793. 200$:    .byte    GN$BYE    ,0
  794. 210$:    .asciz    /Can't get the remote KERMIT to LOGOUT/<cr><lf>
  795.     .even
  796.     .restore
  797.     .dsabl    lsb
  798.  
  799.  
  800. remget::call    seropn            ; get the link line intialzied
  801.     call    sinfo            ; exchange information please
  802.     clr    paknum            ; packet_number := 0
  803.     strlen    argbuf            ; get the length of the filename
  804.     spack    #MSG$RCV,paknum,r0,argbuf ; get the server to send this file
  805.     calls    recsw    ,<#STA.RIN>    ; and call the receiver
  806. 10$:    call    clostt            ; close up the remote link now
  807.     return                ; bye
  808.  
  809.  
  810.  
  811. remhos::call    seropn            ; get the link line intialzied
  812.     call    sinfo            ; exchange information please
  813.     clr    paknum            ; packet_number := 0
  814.     strlen    argbuf            ; get the length of the filename
  815.     spack    #MSG$COMMAND,paknum,r0,argbuf ; get the server to execute
  816.     call    getres            ; off to common code
  817. ;-    call    clostt            ; insure closed
  818.     return
  819.  
  820.  
  821.  
  822.     .sbttl    the remote space, dir, erase and help commands
  823.  
  824.  
  825. remspa::calls    doremo    ,<#GN$DISK,#1,#null>
  826.     clr    r0
  827.     return
  828.  
  829.  
  830.  
  831. remdir::calls    doremo    ,<#GN$DIRECTORY,#1,@r5>
  832.     clr    r0
  833.     return
  834.  
  835.  
  836. remtyp::calls    doremo    ,<#GN$TYPE,#1,@r5>
  837.     clr    r0
  838.     return
  839.  
  840.  
  841. remwho::calls    doremo    ,<#GN$WHO,#1,#null>
  842.     clr    r0
  843.     return
  844.  
  845.  
  846. remera::calls    doremo    ,<#GN$DELETE,#1,@r5>
  847.     clr    r0
  848.     return
  849.  
  850.  
  851. remhlp::calls    doremo    ,<#GN$HELP,#1,#null>
  852.     clr    r0
  853.     return
  854.  
  855. remren::calls    doremo    ,<#GN$RENAME,#2,@r5,2(r5)>
  856.     clr    r0
  857.     return
  858.  
  859. remcop::calls    doremo    ,<#GN$COPY,#2,@r5,2(r5)>
  860.     clr    r0
  861.     return
  862.  
  863. remcwd::mov    2(r5)    ,r0        ; get address of second (password) arg
  864.     tstb    @r0            ; is there anything there (not likely)
  865.     beq    10$            ; no
  866.     calls    doremo    ,<#GN$CONNECT,#2,@r5,2(r5)> ; insert password also
  867.     br    100$            ;
  868. 10$:    calls    doremo    ,<#GN$CONNECT,#1,@r5> ; no password today
  869. 100$:    clr    r0
  870.     return
  871.  
  872. remlgi::mov    2(r5)    ,r0        ; get address of second (password) arg
  873.     tstb    @r0            ; is there anything there (not likely)
  874.     beq    10$            ; no
  875.     calls    doremo    ,<#GN$LOGIN,#2,@r5,2(r5)> ; insert password also
  876.     br    100$            ;
  877. 10$:    calls    doremo    ,<#GN$LOGIN,#1,@r5> ; no password today
  878. 100$:    clr    r0
  879.     return
  880.  
  881.     global    <sinfo>
  882.  
  883.  
  884.  
  885.     .sbttl    carry out the remote command please
  886.  
  887. ;    DOREMOTE handles most generic commands that may have
  888. ;    a variable response, such as a simple ACK ("Y") with
  889. ;    the  response in the data packet, an SINIT or an "X"
  890. ;    packet.
  891.  
  892.  
  893. doremo:    clr    paknum            ; generic command
  894.     sub    #130    ,sp        ; allocate a buffer please
  895.     mov    sp    ,r2        ; point to it
  896.     movb    @r5    ,@r2        ; the generic command to execute
  897.     bicb    #40    ,(r2)+        ; insure command is upper case
  898.     mov    4(r5)    ,r1        ; get the first command argument
  899.     strlen    r1            ; get the length of it please
  900.     tochar    r0    ,(r2)+        ; followed by len of first arg
  901.     copyz    r1    ,r2,#40        ; copy the arglist over please
  902.     cmp    2(r5)    ,#1        ; one or two arguments passed ?
  903.     beq    30$            ; only one
  904. 10$:    tstb    (r2)+            ; two, so find the end so far
  905.     bne    10$            ; not yet
  906.     strlen    6(r5)            ; get the length of the second arg
  907.     dec    r2            ; point back to the null please
  908.     tochar    r0    ,(r2)+        ; and copy the new length over
  909.     copyz    6(r5)    ,r2,#40        ; copy the second arg over now
  910.  
  911. 30$:    mov    sp    ,r0        ; point back to the command buffer
  912.     calls    bufpak    ,<r0,cmdbuf>    ; encoding the data as normal
  913.     mov    r1    ,r5        ; save the encoded packet length
  914.     add    #130    ,sp        ; pop the local buffer and exit
  915.     call    seropn            ; initialize the link first
  916.     call    sinfo            ; exchange things first
  917.     clr    paknum            ; start over now
  918.     clr    numtry            ; clear the retry counter please
  919.  
  920.     spack    #MSG$GENERIC,paknum,r5,cmdbuf    ; send the command over please
  921.  
  922. getres:
  923. 50$:    rpack    r2,r3,#packet        ; get the response from remote
  924.     mov    r3    ,paknum        ; save the packet number please
  925.     scan    r1    ,#remrsp    ; what to do with the response
  926.     asl    r0            ; get the index times 2
  927.     jsr    pc    ,@remdsp(r0)    ; and dispatch on the response
  928.     tst    r0            ; try to read again ?
  929.     bne    50$            ; yes, we must have gotten a NAK
  930.     call    clostt            ; close the link for now
  931.     clr    xmode            ; no extended reply stuff now
  932.     clr    xgottn            ; we don't have any X packets
  933.     clr    r0            ; don't exit the server yet
  934.     return                ; or a timeout
  935.  
  936.     .save
  937.     .psect    $Pdata,d
  938. remrsp:    .byte    MSG$ERROR,MSG$NAK,MSG$SND,MSG$ACK,MSG$TEXT
  939.     .byte    timout    ,badchk    ,0
  940.     .even
  941.  
  942. remdsp:    .word    rem.$
  943.     .word    rem.e    ,rem.n    ,rem.s    ,rem.y    ,rem.x
  944.     .word    rem.t    ,rem.ck
  945.     .restore
  946.  
  947.  
  948.  
  949.  
  950.     .sbttl    routines for doremote
  951.  
  952.  
  953. rem.t:    inc    numtry            ; timeout error
  954.     cmp    numtry    ,#10        ; been trying too hard ?
  955.     bhi    10$            ; yes, abort please
  956.     mov    #1    ,r0        ; no, return code to do rpack again
  957.     return
  958. 10$:    message    <Remote fails to respond to the command>,cr
  959.     clr    r0            ; ok
  960.     return
  961.  
  962.  
  963. rem.n:    inc    numtry            ; got a NAK back from remote
  964.     cmp    numtry    ,#5        ; been trying too hard ?
  965.     bhi    10$            ; yes, abort please
  966.     spack    #MSG$GENERIC,paknum,r5,cmdbuf    ; send command again please
  967.     mov    #1    ,r0        ; no, return code to do rpack again
  968.     return
  969. 10$:    message    <Remote NAK'ed the command 5 times>,cr
  970.     clr    r0            ; ok
  971.     return
  972.  
  973.  
  974. rem.ck:    inc    numtry            ; got a NAK back from remote
  975.     cmp    numtry    ,#5        ; been trying too hard ?
  976.     bhi    10$            ; yes, abort please
  977.     spack    #MSG$GENERIC,paknum,r5,cmdbuf    ; send command again please
  978.     mov    #1    ,r0        ; no, return code to do rpack again
  979.     return
  980. 10$:    message    <Bad checksum retry abort>,cr
  981.     clr    r0            ; ok
  982.     return
  983.  
  984.  
  985. rem.x:    mov    sp    ,xmode        ; set a global flag for this
  986.     mov    sp    ,xgottn        ; we already have the x packet
  987.     message    <Remote server response>,cr
  988.     calls    rec.sw    ,<#STA.FIL>    ; yes, switch to receive DATA
  989.     clr    xmode            ; no longer want output to TI:
  990.     clr    xgottn            ; we don't have any X packets
  991.     message                ; a cr/lf
  992.     tst    r0            ; did the receive succeed ?
  993.     beq    rxend            ; yes
  994.     message    <Receive data failed>,cr; no, please say so then
  995. rxend:    clr    r0            ; all done
  996.     return
  997.  
  998.  
  999. rem.s:    calls    rpar    ,<#packet,r2>    ; yes, handle the SINIT now
  1000.     calls    spar    ,<#packet>    ; and send my init things over
  1001.     spack    #MSG$ACK,paknum,sparsz,#packet
  1002.     incm64    paknum            ; bump the packet number up mod 64
  1003.     calls    rec.sw    ,<#STA.FIL>    ; switch to get fileheader state
  1004.     message
  1005.     clr    r0            ; all done
  1006.     return
  1007.  
  1008.  
  1009. rem.y:    strlen    #packet            ; any data in the field ?
  1010.     tst    r0            ; if so, simply print it out
  1011.     bne    10$            ; no, just exit
  1012.     return
  1013. 10$:    message    <Remote ack: >
  1014.     print    #packet            ; yes, print the text out please
  1015.     print    #crlf            ; a cr/lf perhaps ?
  1016.     clr    r0            ; all done
  1017.     return
  1018.  
  1019.  
  1020. rem.e:    calls    error    ,<#1,#packet>    ; yes, print the error text out
  1021.     clr    r0            ; all done
  1022.     return                ; and exit please
  1023.  
  1024. rem.$:    calls    error    ,<#1,#nores>    ; otherwise say they did not respond
  1025.     clr    r0
  1026.     return                ; and exit please
  1027.  
  1028.     .save
  1029.     .psect    $Pdata,d
  1030. nores:    .asciz    /Can't get the remote KERMIT to respond/
  1031.     .even
  1032.     .restore
  1033.  
  1034.     global    <clostt    ,seropn    ,paknum    ,sparsz    ,xmode>
  1035.     global    <xgottn>
  1036.  
  1037.  
  1038.  
  1039.  
  1040.     .sbttl    initialize for a long (X) response for generic command
  1041.  
  1042.  
  1043. ;     Here is where we send an X packet back to the requesting Kermit
  1044. ;    to  say that we are going to send an extended reply to it.  This
  1045. ;    reply takes the form of a  normal file transfer but we will want
  1046. ;    it to be printed on the user's terminal rather than go to a disk
  1047. ;    file. Thus the use of the 'X' packet to start things off.
  1048.  
  1049.  
  1050. xreply:    copyz    r0    ,#srcnam    ; copy the filename to be sent
  1051.     clrb    filnam            ; /38/ insure cleared out
  1052.     clr    index            ; wildcard filenumber := 0
  1053.     tstb    srcnam            ; /38/ is there really a file?
  1054.     beq    20$            ; /38/ no, ignore lookup then.
  1055.     call    getnxt            ; go do a directory lookup please
  1056.     tst    r0            ; well, did the lookup work out ?
  1057.     beq    20$
  1058. 5$:    call    generr            ; no, send the error text over
  1059.     br    100$            ; and abort
  1060. 20$:    mov    sp    ,xmode
  1061.     calls    sen.sw    ,<#STA.FIL>    ; and switch to senddata state
  1062.     clr    xmode            ; no longer XTENDED reply mode
  1063.     clr    xgottn            ; we don't have any X packets (?)
  1064.     clr    r0            ; success (?)
  1065. 100$:    textsrc                ; /38/ reset to normal file i/o
  1066.     return                ; bye
  1067.  
  1068.  
  1069.  
  1070.  
  1071.  
  1072.     global    <getnxt    ,index    ,inopn    ,lun.in    ,size>
  1073.  
  1074.  
  1075.     .enabl    lsb
  1076.  
  1077. seropn:    save    <r1>
  1078.     call    opentt            ; open the link for a server command
  1079.     tst    r0            ; did it work ?
  1080.     beq    10$            ; yes
  1081.     strlen    #200$            ; no
  1082.     spack    #MSG$ERROR,paknum,r0,#200$    ; try to send an error packet
  1083.     clr    r0            ; no errors now
  1084. 10$:    calls    cantyp    ,<#ttname,#lun.ti>; flush any accumulated NAKS
  1085.     unsave    <r1>
  1086.     return                ; bye
  1087.  
  1088.  
  1089.     .save
  1090.     .psect    $Pdata,d
  1091. 200$:    .asciz    /Init failed for link/
  1092.     .even
  1093.     .restore
  1094.     .dsabl    lsb
  1095.  
  1096.  
  1097.     global    <lun.ti    ,paknum    ,ttname>
  1098.  
  1099.  
  1100.     .end
  1101.