home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / b / krtser.min < prev    next >
Text File  |  2020-01-01  |  9KB  |  559 lines
  1.     .title    KRTSER.MIN  The server
  2.     .ident    "V03.62"
  3.  
  4. ; /62/    31-May-93  Billy Youdelman
  5.  
  6.     .include "IN:KRTMAC.MIN"
  7.     .iif ndf  KRTINC  .error    <; .include for IN:KRTMAC.MIN failed>
  8.     .include "IN:KRTDEF.MIN"
  9.     .iif ndf  MSG$DA  .error    <; .include for IN:KRTDEF.MIN failed>
  10.  
  11.     .mcall    .PURGE
  12.  
  13.     .macro    dispat    val,dsp,baseval,basedsp,default
  14.     .list me
  15.     .save
  16.     .nlist me
  17.     .if nb <baseval>
  18.     .list me
  19.     .psect    genval    ,ro,d,lcl,rel,con
  20. baseval:
  21.     .psect    gendsp    ,ro,d,lcl,rel,con
  22. basedsp:
  23.     .word    default
  24.     .nlist me
  25.     .iff
  26.     .list me
  27.     .psect    genval    ,ro,d,lcl,rel,con
  28.     .nlist me
  29.       .if b  <val>
  30.       .byte     0
  31.       .even
  32.       .iff
  33.       .byte     val
  34.       .list     me
  35.       .psect gendsp    ,ro,d,lcl,rel,con
  36.       .nlist me
  37.       .word     dsp
  38.       .endc
  39.     .endc
  40.     .list me
  41.     .restore
  42.     .nlist me
  43.     .endm
  44.  
  45.  
  46.     .sbttl    Local data
  47.  
  48.     .psect    $pdata
  49. C20$:    .asciz    " block(s) copied to "
  50. C110$:    .asciz    "DK  --> "
  51. delmsg:    .asciz    " deleted"
  52. exitxt:    .asciz    <cr><lf>"%KRTSER-I-Server stopped"<cr><lf>
  53. htxt:  .ascii "The following commands are available on this Kermit-11"<cr><lf>
  54.        .ascii "server.  To avoid ambiguity with local Kermit commands"<cr><lf>
  55.        .ascii "most of these server commands must be prefixed by the"<cr><lf>
  56.        .ascii "REMOTE keyword."<cr><lf><lf>
  57.     .ascii    "REMOTE COPY    Copy a file to another"<cr><lf>
  58.     .ascii    "REMOTE CWD    Changes server default"<cr><lf>
  59.     .ascii    "REMOTE DELETE    Erases specified  file"<cr><lf>
  60.     .ascii    "REMOTE DIR    Displays  a  directory"<cr><lf>
  61.     .ascii    "FINISH        Exit server, reconnect"<cr><lf>
  62.     .ascii    "GET        Send file(s) to remote"<cr><lf>
  63.     .ascii    "REMOTE HELP    Prints this  help text"<cr><lf>
  64.     .ascii    "REMOTE RENAME    Rename old file to new"<cr><lf>
  65.     .ascii    "SEND        Send file(s) to server"<cr><lf>
  66.     .ascii    "REMOTE SPACE    Shows blocks used/free"<cr><lf>
  67.     .ascii    "REMOTE TYPE    Types a specified file"<cr><lf>
  68.     .byte    0
  69. invarg:    .asciz    "?KRTSER-E-Invalid arguments for remote server command"
  70. notimp:    .asciz    "?KRTSER-W-Unimplemented server command"
  71. notgen:    .asciz    "?KRTSER-W-Unimplemented server generic command"
  72. R20$:    .asciz    "1 file renamed"
  73. serpre:    .asciz    "%KRTSER-I-Server starting"
  74. sertxt:    .ascii    ".  Return to your local machine by typing"<cr><lf>
  75.     .ascii    "its escape sequence for closing the connection,"
  76.     .ascii    " then issue further"<cr><lf>
  77.     .ascii    "commands from there.  To shut down the server,"
  78.     .ascii    " use the BYE command"<cr><lf>
  79.     .asciz    "to logout, or the FINISH command and then reconnect."
  80. typdef:    .asciz    ".LST"
  81.     .even
  82.  
  83.  
  84.     .psect    $code
  85.     .sbttl    Call the server
  86.  
  87. c$serv::tstb    @argbuf
  88.     beq    1$
  89.     mov    #er$ser    ,r0
  90.     br    90$
  91.  
  92. 1$:    wrtall    #serpre
  93.     tst    infomsg
  94.     beq    30$
  95.     wrtall    #sertxt
  96.  
  97. 30$:    .newline
  98.     call    seropn
  99.     tst    r0
  100.     bne    99$
  101.     call    server
  102.     wrtall    #exitxt
  103.     br    99$
  104.  
  105. 90$:    direrr    r0
  106. 99$:    clr    r0
  107.     jmp    clostt
  108.  
  109.  
  110.     .sbttl    Server main_loop
  111.  
  112. server::clr    paknum
  113.     textsrc
  114.     mov    #defchk    ,chktyp
  115.     mov    #1    ,chksiz
  116.     mov    $image    ,image
  117.     clr    summary
  118.     clr    dirflg
  119.     call    fixchk
  120.     mov    serwai    ,sertim
  121.     bit    #log$pa    ,trace
  122.     beq    3$
  123.     calls    putrec    ,<#0,#0,#lun.lo>
  124.     tst    r0
  125.     beq    3$
  126.     call    logerr
  127. 3$:    rpack    r2 ,r3    ,#packet,#maxlng
  128.     clr    sertim
  129.     movb    sentim    ,senpar+p.time
  130.     scan    r1    ,#sercom
  131.     asl    r0
  132.     jsr    pc    ,@serdsp(r0)
  133.     tst    r0
  134.     beq    server
  135.  
  136. 100$:    calls    suspend    ,<#1>
  137.     jmp    clrcns
  138.  
  139.     dispat    basedsp=serdsp    ,baseval=sercom    ,default=serv.$
  140.  
  141.     dispat    MSG$SND        ,serv.s
  142.     dispat    MSG$RCV        ,serv.r
  143.     dispat    MSG$GENERIC    ,serv.g
  144.     dispat    MSG$SER        ,serv.i
  145.     dispat    TIMOUT        ,serv$$
  146.     dispat    BADCHK        ,serchk
  147.     dispat    MSG$NAK        ,serv$$
  148.     dispat    MSG$ACK        ,serv$$
  149.     dispat    MSG$COMMAND    ,serv.$
  150.     dispat    MSG$ERROR    ,sernop
  151.     dispat
  152.  
  153.  
  154.     .sbttl    Server routines
  155.  
  156. serv.$:    strlen    #notimp
  157.     spack    #msg$error,paknum,r0,#notimp
  158.     clr    r0
  159.     return
  160.  
  161. serv$$:
  162. serchk:    mov    r3    ,paknum
  163.     spack    #msg$nak,paknum
  164. sernop:    clr    r0
  165.     return
  166.  
  167. serv.i:    mov    r3    ,paknum
  168.     calls    rpar    ,<#packet,r2>
  169.     calls    spar    ,<#packet>
  170.     spack    #msg$ack,paknum,sparsz,#packet
  171.     clr    r0
  172.     jmp    inirepeat
  173.  
  174. serv.s:    mov    r3    ,paknum
  175.     calls    rpar    ,<#packet,r2>
  176.     calls    spar    ,<#packet>
  177.     spack    #msg$ack,paknum,sparsz,#packet
  178.     call    inirepeat
  179.     incm64    paknum
  180.     calls    rec.sw    ,<#sta.fil>
  181.     clr    r0
  182.     return
  183.  
  184. serv.r:    calls    bufunp    ,<#packet,#spare1>
  185.     clrb    spare1(r1)
  186.     upcase    #spare1
  187.     calls    fparse,<#spare1,#srcnam>
  188.     tst    r0
  189.     bne    90$
  190.     calls    fixwild    ,<#srcnam>
  191.     clr    index
  192.     call    getnxt
  193.     tst    r0
  194.     bne    100$
  195.     calls    sen.sw    ,<#sta.sin>
  196.     br    100$
  197.  
  198. 90$:    call    generr
  199. 100$:    clr    r0
  200.     return
  201.  
  202.  
  203.     .sbttl    Generic command processor
  204.  
  205. serv.g:    clr    at$len
  206.     sub    #200    ,sp
  207.     mov    sp    ,r2
  208.     copyz    #packet    ,r2    ,#176
  209.     calls    bufunp    ,<r2,#packet>
  210.     add    #200    ,sp
  211.     movb    packet+0,r2
  212.     scan    r2    ,#gencom
  213.     asl    r0
  214.     jmp    @gendsp(r0)
  215.  
  216.     dispat    basedsp=gendsp    ,baseval=gencom    ,default=gen.$
  217.  
  218.     dispat    GN$LOGIN    ,gen.$
  219.     dispat    GN$EXIT        ,gen.f
  220.     dispat    GN$CONNECT    ,gen.c
  221.     dispat    GN$BYE        ,gen.l
  222.     dispat    GN$DIRECTORY    ,gen.d
  223.     dispat    GN$DISK        ,gen.u
  224.     dispat    GN$DELETE    ,gen.e
  225.     dispat    GN$SUBMIT    ,gen.$
  226.     dispat    GN$WHO        ,gen.$
  227.     dispat    GN$SEND        ,gen.$
  228.     dispat    GN$HELP        ,gen.h
  229.     dispat    GN$QUERY    ,gen.$
  230.     dispat    GN$RENAME    ,gen.r
  231.     dispat    GN$COPY        ,gen.k
  232.     dispat    GN$PRINT    ,gen.$
  233.     dispat    GN$PROGRAM    ,gen.$
  234.     dispat    GN$JOURNAL    ,gen.$
  235.     dispat    GN$VARIABLE    ,gen.$
  236.     dispat    GN$TYPE        ,gen.t
  237.     dispat
  238.  
  239.  
  240.     .sbttl    Kermit generic routines
  241.  
  242. gen.$:    strlen    #notgen
  243.     spack    #msg$error,paknum,r0,#notgen
  244.     clr    r0
  245.     return
  246.  
  247. gen.f:    spack    #msg$ack,paknum
  248.     mov    sp    ,r0
  249.     jmp    clostt
  250.  
  251. gen.l:    spack    #msg$ack,paknum
  252.     call    clostt
  253.     bit    #log$op    ,trace
  254.     beq    20$
  255.     calls    close    ,<#lun.lo>
  256. 20$:    jmp    exit
  257.  
  258.  
  259.     .sbttl    Generic COPY
  260.  
  261. gen.k:    call    get2ar
  262.     bcs    90$
  263.     upcase    r1
  264.     upcase    r2
  265.     calls    fparse    ,<r1,#srcnam>
  266.     clr    index
  267.     calls   lookup  ,<#srcnam,#spare1>
  268.     .purge    #lun.sr
  269.     calls    copy    ,<r1,r2>
  270.     tst    r0
  271.     bne    80$
  272.     sub    #50    ,sp
  273.     mov    sp    ,r3
  274.     deccvt    r1 ,r3    ,#5
  275.     add    #5    ,r3
  276.     strcpy    r3    ,#C20$
  277.     strcat    r3    ,#filnam
  278.     mov    sp    ,r3
  279.     strlen    r3
  280.     spack    #msg$ack,paknum,r0,r3
  281.     add    #50    ,sp
  282.     br    100$
  283.  
  284. 80$:    call    generr
  285.     br    100$
  286.  
  287. 90$:    calls    error    ,<#1,#invarg>
  288. 100$:    clr    r0
  289.     return
  290.  
  291.  
  292.     .sbttl    Generic CWD
  293.  
  294. gen.c:    mov    #packet+1,r1
  295.     unchar    (r1)+    ,r2
  296.     bne    31$
  297.     strcpy    #defdir    ,#dkname
  298.     br    55$
  299.  
  300. 31$:    add    r1    ,r2
  301.     dec    r2
  302.     cmpb    (r2)+    ,#':
  303.     beq    32$
  304.     movb    #':    ,(r2)+
  305.  
  306. 32$:    clrb    @r2
  307.     upcase    r1
  308.     calls    fparse,<r1,#spare1>
  309.     tst    r0
  310.     bne    70$
  311.     strcpy    #defdir    ,#spare1
  312.  
  313. 55$:    sub    #40    ,sp
  314.     mov    sp    ,r2
  315.     strcpy    r2    ,#C110$
  316.     strcat    r2    ,#defdir
  317.     strlen    r2
  318.     spack    #msg$ack,paknum,r0,r2
  319.     add    #40    ,sp
  320.     br    100$
  321.  
  322. 70$:    call    generr
  323. 100$:    clr    r0
  324.     return
  325.  
  326.  
  327.     .sbttl    Generic DELETE
  328.  
  329. gen.e:    mov    #packet+1,r1
  330.     unchar    (r1)+    ,r2
  331.     bne    10$
  332.     clrb    @r1
  333. 10$:    upcase    r1
  334.     calls    delete    ,<r1,#lun.ou>
  335.     tst    r0
  336.     beq    80$
  337.     call    generr
  338.     br    100$
  339.  
  340. 80$:    strcpy    #errtxt    ,#srcnam
  341.     strcat    #errtxt    ,#delmsg
  342.     strlen    #errtxt
  343.     spack    #msg$ack,paknum,r0,#errtxt
  344.  
  345. 100$:    clr    r0
  346.     return
  347.  
  348.  
  349.     .sbttl    Generic DIRECTORY and SPACE
  350.  
  351. gen.u:    mov    sp    ,summary
  352. gen.d:    mov    #packet+1,r1
  353.     unchar    (r1)+    ,r2
  354.     add    r1    ,r2
  355.     clrb    @r2
  356.     upcase    r1
  357.     calls    fixwild    ,<r1>
  358.     calls    sdirini    ,<r1>
  359.     tst    r0
  360.     bne    99$
  361. 10$:    mov    #sdodir    ,getcroutine
  362.     mov    #null    ,r0
  363.     call    xreply
  364.     tst    r0
  365.     beq    100$
  366.  
  367. 99$:    call    generr
  368. 100$:    clr    r0
  369.     return
  370.  
  371.  
  372.     .sbttl    Generic HELP
  373.  
  374. gen.h:    textsrc    #htxt
  375.     mov    #null    ,r0
  376.     call    xreply
  377.     clr    r0
  378.     return
  379.  
  380.  
  381.     .sbttl    Generic RENAME
  382.  
  383. gen.r:    call    get2ar
  384.     bcs    90$
  385.     upcase    r1
  386.     upcase    r2
  387.     calls    rename    ,<r1,r2,#-1>
  388.     tst    r0
  389.     bne    80$
  390.     strlen    #R20$
  391.     spack    #msg$ack,paknum,r0,#R20$
  392.     br    100$
  393.  
  394. 80$:    call    generr
  395.     br    100$
  396.  
  397. 90$:    calls    error    ,<#1,#invarg>
  398. 100$:    clr    r0
  399.     return
  400.  
  401.  
  402.     .sbttl    Generic TYPE
  403.  
  404. gen.t:    mov    #packet+1,r1
  405.     unchar    (r1)+    ,r2
  406.     beq    12$
  407.     add    r1    ,r2
  408.     clrb    @r2
  409.     upcase    r1
  410.  
  411.     scan    #'.    ,r1
  412.     tst    r0
  413.     bne    10$
  414.     strcat    r1    ,#typdef
  415.  
  416. 10$:    calls    iswild    ,<r1>
  417.     tst    r0
  418.     bne    20$
  419.  
  420.     calls    fparse,<r1,#spare1>
  421.     tst    r0
  422.     beq    30$
  423.  
  424.     mov    #er$dev    ,r0
  425.     br    20$
  426. 12$:    mov    #er$fnm    ,r0
  427. 20$:    call    generr
  428.     br    100$
  429.  
  430. 30$:    mov    #spare1    ,r0
  431.     call    xreply
  432. 100$:    clr    r0
  433.     return
  434.  
  435.  
  436.     .sbttl    Generic command error handler
  437.  
  438. generr:    calls    syserr    ,<r0,#errtxt>
  439.     calls    error    ,<#1,#errtxt>
  440.     clr    r0
  441.     return
  442.  
  443.  
  444.     .sbttl    Get pointers for a two argument server command
  445.  
  446. get2ar:    save    <r3,r4>
  447.     mov    #packet+1,r3
  448.     tstb    @r3
  449.     beq    90$
  450.     unchar    (r3)+    ,r4
  451.     beq    90$
  452.     mov    r3    ,r1
  453.     add    r4    ,r3
  454.     tstb    @r3
  455.     beq    90$
  456.     unchar    (r3)+    ,r4
  457.     beq    90$
  458.     mov    r3    ,r2
  459.     clrb    -(r3)
  460.     clc
  461.     br    100$
  462. 90$:    sec
  463. 100$:    unsave    <r4,r3>
  464.     return
  465.  
  466.  
  467.     .sbttl    Buffil but get data from a buffer
  468.  
  469. bufpak::mov    2(r5)    ,r4
  470.     mov    @r5    ,r5
  471.     clr    r3
  472.  
  473. 10$:    clr    r1
  474.     bisb    (r5)+    ,r1
  475.     beq    90$
  476.     clr    r2
  477.     bisb    r1    ,r2
  478.     bic    #^c177    ,r2
  479.     cmpb    r2    ,#space
  480.     blo    20$
  481.     cmpb    r2    ,#del
  482.     beq    20$
  483.     cmpb    r2    ,senpar+p.qctl
  484.     bne    40$
  485.  
  486. 20$:    movb    senpar+p.qctl,(r4)+
  487.     inc    r3
  488.     cmpb    r2    ,senpar+p.qctl
  489.     beq    30$
  490.     ctl    r1    ,r1
  491.     ctl    r2    ,r2
  492. 30$:
  493. 40$:    tst    image
  494.     beq    50$
  495.     movb    r1    ,(r4)+
  496.     br    60$
  497. 50$:    movb    r2    ,(r4)+
  498. 60$:    inc    r3
  499.  
  500. 70$:    clr    -(sp)
  501.     bisb    conpar+p.spsiz,@sp
  502.     bne    80$
  503.      mov    #maxpak    ,@sp
  504. 80$:    sub    #10    ,@sp
  505.     cmp    r3    ,(sp)+
  506.     blo    10$
  507.  
  508. 90$:    mov    r3    ,r1
  509.     return
  510.  
  511.  
  512.     .sbttl    Initialize for an extended reply to a generic command
  513.  
  514. xreply:    strcpy    #srcnam    ,r0
  515.     clrb    filnam
  516.     tstb    srcnam
  517.     beq    20$
  518.     clr    index
  519.     call    getnxt
  520.     tst    r0
  521.     bne    30$
  522. 20$:    mov    sp    ,xmode
  523.     calls    sen.sw    ,<#sta.fil>
  524. 30$:    clr    xmode
  525.     clr    xgottn
  526.     clr    r0
  527. 100$:    textsrc
  528.     return
  529.  
  530.  
  531.     .sbttl    Open link and flush NAKs
  532.  
  533. seropn:    save    <r1>
  534.     call    opentt
  535.     tst    r0
  536.     bne    11$
  537.     call    cantyp
  538. 11$:    unsave    <r1>
  539.     return
  540.  
  541.  
  542.     .sbttl    Server init
  543.  
  544. sinfo:    save
  545.     bit    #log$pa    ,trace
  546.     beq    3$
  547.     calls    putrec    ,<#0,#0,#lun.lo>
  548.     tst    r0
  549.     beq    3$
  550.     call    logerr
  551. 3$:    clr    numtry
  552.     clr    paknum
  553.     movb    #msg$ser,-(sp)
  554.     call    .sinit
  555.     unsave
  556.     return
  557.  
  558.     .end
  559.