home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pdp11 / k11lcl.mac < prev    next >
Text File  |  2020-01-01  |  8KB  |  307 lines

  1.     .title    k11lcl    do things for site specific stuff
  2.     .ident    /1.2.01/
  3.  
  4.  
  5.  
  6.     .if ndf, K11INC
  7.     .ift
  8.     .include    /IN:K11MAC.MAC/
  9.     .endc
  10.  
  11.  
  12.     .psect    $code
  13.  
  14.  
  15. ;    18-Jan-84  11:27:39  Brian Nelson
  16. ;    22-Mar-84  15:46:51  BDN rewrite for tkb/onlpat patching
  17.  
  18.  
  19.  
  20.     .sbttl    okuser
  21.  
  22.  
  23. ;    input:    2(sp)    address of an  .asciz string  containing  the first
  24. ;            three (3) characters of the current command name.
  25. ;    output:    nothing
  26. ;
  27. ;    You have the option (see K11CDF.MAC for the $NAME macro) of  either
  28. ;    doing a  MOV (SP)+,@SP   and a RETURN (accepting the command) or of
  29. ;    doing a  CMP (SP)+,(SP)+ and a RETURN (rejecting the command).
  30. ;
  31.  
  32.  
  33.  
  34.  
  35.  
  36. okuser::mov    2(sp)    ,r0
  37.     mov    #clist    ,r2        ; point to the protection byte
  38.  
  39. 10$:    tstb    1(r2)            ; if the text is null, we are done
  40.     beq    100$            ; bye
  41.     tstb    @r2            ; if the protection byte is null,
  42.     beq    50$            ; then skip this entry
  43.     cmpb    1(r2)    ,@r0        ; check for a match on this entry
  44.     bne    50$            ; no match
  45.     cmpb    2(r2)    ,1(r0)        ; check byte number 2
  46.     bne    50$            ; no match
  47.     cmpb    3(r2)    ,2(r0)        ; check byte number 2
  48.     bne    50$            ; no match
  49.  
  50.     call    getuic            ; get the ppn
  51.     tst    ...uic            ; check based on the group number?
  52.     beq    20$            ; no
  53.     swab    r0            ; yes, get group number over please
  54.     cmpb    r0    ,...uic+0    ; check it out now
  55.     blos    30$            ; it's ok
  56.     br    90$            ; it's not, exit with error
  57.     
  58.  
  59. 20$:    tst    ...uic+2        ; no, try checks based on programmer #
  60.     beq    30$            ; no checks exit with success
  61.     cmpb    r0    ,...uic+2    ; check based on this now
  62.     blos    30$            ; it's ok, exit
  63.     br    90$            ; it's not ok, exit
  64.  
  65. 30$:    call    getuic            ; last check is to see if the command
  66.     swab    r0            ; itself is restricted based on group #
  67.     cmpb    r0    ,@r2        ; by checking the protection byte for a
  68.     bhi    90$            ; group number match. if >, then error
  69.     br    100$            ; it's ok, exit
  70.  
  71. 50$:    add    #4    ,r2        ; point to the next table entry
  72.     br    10$            ; next please
  73.  
  74.  
  75. 90$:    print    #rs            ; a match, disallow the command
  76.     cmp    (sp)+    ,(sp)+
  77.     return
  78. 100$:    mov    (sp)+    ,@sp
  79.     return
  80.  
  81.  
  82.     .save
  83.     .psect    $PDATA    ,D
  84. rs:    .asciz    /Access not allowed to this command/<cr><lf>
  85.     .even
  86.     .restore
  87.  
  88.     global    <getuic>
  89.  
  90.  
  91.  
  92.  
  93.     .sbttl    the list of commands to check
  94.     .psect    $pdata
  95.  
  96.  
  97. ;    To enable checks, patch the first byte from 0 to 377.
  98. ;    For example,  to make the DIR command unavailable to
  99. ;    non-priv users, patch ..$DIR byte offset 0 from 0 to
  100. ;    377 octal.
  101. ;    Also, please note that the first check will be based
  102. ;    on project (group) number as a check lower or same.
  103. ;     If ...uic+0 = 0 then that check is skipped in favor
  104. ;    of  checking the programmer  number in ...uic+2.  If
  105. ;    that is zero, then no checking will be done.
  106. ;
  107. ;
  108. ;    As in:
  109. ;
  110. ;
  111. ;    procedure check_commands
  112. ;
  113. ;      i := 0 ;
  114. ;      found_a_match := false ;
  115. ;      while ( clist[i][1] <> 0 ) and not found_a_match
  116. ;       do
  117. ;        begin
  118. ;          if clist[i][0] <> 0
  119. ;           then
  120. ;             found_a_match :=    cmd_name[0] = clist[i][1]
  121. ;                     and cmd_name[1] = clist[i][2]
  122. ;                     and cmd_name[2] = clist[i][3] ;
  123. ;          i := succ(i) ;
  124. ;        end ;
  125. ;      bad_command := false ;
  126. ;      if found_a_match
  127. ;        then
  128. ;        if (...uic <> 0 ) and ( group_number > ...uic )
  129. ;            then bad_command := true
  130. ;        else
  131. ;           if (...uic+2 <> 0 ) and ( programmer_number > ...uic+2 )
  132. ;            then bad_command := true ;
  133. ;      if not bad_command
  134. ;        then
  135. ;        if ( group_number > clist[i][0]
  136. ;          then bad_command := true
  137. ;
  138. ;    end ;
  139. ;               
  140. ;
  141.  
  142. ...uic::.word    0            ; no checks on group number
  143.     .word    0            ; no checks on user number
  144.  
  145. clist:
  146. ..$bye::.ascii    <000>/BYE/        ; BYE         
  147. ..$com::.ascii    <000>/COM/        ; COMMENT     
  148. ..$con::.ascii    <000>/CON/        ; CONNECT     
  149. ..$cop::.ascii    <000>/COP/        ; COPY        
  150. ..$del::.ascii    <000>/DEL/        ; DELETE      
  151. ..$dir::.ascii    <000>/DIR/        ; DIRECT      
  152. ..$dis::.ascii    <000>/DIS/        ; DISCONNECT  
  153. ..$era::.ascii    <000>/ERA/        ; ERASE       
  154. ..$exi::.ascii    <000>/EXI/        ; EXIT        
  155. ..$fin::.ascii    <000>/FIN/        ; FINISH      
  156. ..$get::.ascii    <000>/GET/        ; GET         
  157. ..$han::.ascii    <000>/HAN/        ; HANGUP      
  158. ..$hel::.ascii    <000>/HEL/        ; HELP        
  159. ..$loc::.ascii    <000>/LOC/        ; LOCAL       
  160. ..$log::.ascii    <000>/LOG/        ; LOGOUT      
  161. ..$not::.ascii    <000>/NOT/        ; NOTE        
  162. ..$qui::.ascii    <000>/QUI/        ; QUIT        
  163. ..$rec::.ascii    <000>/REC/        ; RECEIVE     
  164. ..$rem::.ascii    <000>/REM/        ; REMOTE      
  165. ..$ren::.ascii    <000>/REN/        ; RENAME      
  166. ..$rdi::.ascii    <000>/RDI/        ; REMOTE DIR
  167. ..$sen::.ascii    <000>/SEN/        ; SEND        
  168. ..$ser::.ascii    <000>/SER/        ; SERVER      
  169. ..$set::.ascii    <000>/SET/        ; SET         
  170. ..$sho::.ascii    <000>/SHO/        ; SHOW        
  171. ..$spa::.ascii    <000>/SPA/        ; SPACE       
  172. ..$sys::.ascii    <000>/SYS/        ; SYSTEM      
  173. ..$tak::.ascii    <000>/TAK/        ; TAKE        
  174. ..$tra::.ascii    <000>/TRA/        ; TRANSMIT    
  175. ..$typ::.ascii    <000>/TYP/        ; TYPE        
  176. ..$who::.ascii    <000>/WHO/        ; WHO         
  177.     .byte    0,0,0,0
  178.     .even
  179.  
  180.  
  181.     .sbttl    using onlpat for RSTS/E to patch this
  182.  
  183.  
  184.     .if ne    ,0
  185.     .ift
  186.  
  187.  
  188. !    RSTS/E Kermit optional patches
  189. !
  190. !    Brian Nelson  30-Mar-84  09:47:07
  191. !
  192. !
  193. !     Example of patching RSTS/E Kermit to disable commands based
  194. !    on user programmer  number.  The  effect  of  the  following
  195. !    patches  is  to  disallow  any user with a programmer number
  196. !    greater than  127  (ie,  100,221)  to  access  the  commands
  197. !    DELETE  ,DIRECTORY,  ERASE  and RENAME. If you would like to
  198. !    do this based  on  project  number  instead  you  can  patch
  199. !    either  ...UIC+0  to  be  the  high  cutoff point instead of
  200. !    patching ...UIC+2, or you can use different project  numbers
  201. !    for  each  command by changing the '377' (which is in octal)
  202. !    to the desired cutoff point. To restict access  to  the  DIR
  203. !    command  to  users  with  a project (group) number less than
  204. !    (10,*), you would patch ..$DIR byte offset zero  from  0  to
  205. !    10.  (the  '.'  is  needed  to force ONLPAT to use a decimal
  206. !    interpretation of the number. 
  207. !
  208. !     At this  time the only other thing you may want to patch is
  209. !    location ..DIRP offset  zero, which  is by  default 1.  This
  210. !    value is checked  against  the user's project  number by the
  211. !    DIRECTORY command.  If the user's project  number is greater
  212. !    than  this number,  the ppn (uic) field  for the DIR command
  213. !    is zeroed,  thus  preventing that  user from looking  at the
  214. !    directory listing  of ANY other  account.  The default is to
  215. !    restrict the use  of ppn's for this  command to  [1,*] users
  216. !    only.  The last patch here changes that to include [2,*].
  217. !
  218. !
  219. ! Keep user's with programmer numbers > 127 from using DIR, DEL, REN and ERA.
  220. !
  221. !
  222. File to patch? 
  223. Base address? ...UIC+2
  224. Offset address? 0
  225.  Base    Offset  Old     New?
  226. ??????    000000    000000    ? 127.
  227. ??????    000002    041000    ? ^Z
  228. Offset address? ^Z
  229. Base address? ..$DEL
  230. Offset address? -1
  231.  Base    Offset  Old     New?
  232. ??????    177777       120    ? <LF>
  233. ??????    000000       000    ? 377
  234. ??????    000001       104    ? ^Z
  235. Offset address? ^Z
  236. Base address? ..$DIR
  237. Offset address? -1
  238.  Base    Offset  Old     New?
  239. ??????    177777       114    ? <LF>
  240. ??????    000000       000    ? 377
  241. ??????    000001       104    ? ^Z
  242. Offset address? ^Z
  243. Base address? ..$ERA
  244. Offset address? -1
  245.  Base    Offset  Old     New?
  246. ??????    177777       123    ? <LF>
  247. ??????    000000       000    ? 377
  248. ??????    000001       105    ? ^Z
  249. Offset address? ^Z
  250. Base address? ..$REN
  251. Offset address? -1
  252.  Base    Offset  Old     New?
  253. ??????    177777       115    ? <LF>
  254. ??????    000000       000    ? 377
  255. ??????    000001       122    ? ^Z
  256. Offset address? ^Z
  257. Base address? ..DIRP
  258. Offset address? 0
  259.  Base    Offset  Old     New?
  260. ??????    000000    000001    ? 2
  261. ??????    000002    ??????    ? ^C
  262.  
  263.  
  264.     .endc
  265.  
  266.  
  267.  
  268.     .sbttl    possibly throttle back non priv users speed
  269.  
  270.     .psect    $pdata
  271.  
  272. slowgr::.word    2            ; cutoff for group numbers
  273. slowdo::.word    0            ; if <> 0, then slow xfers down
  274. slowbd::.word    1200.
  275.     .psect    $code            ; resume r/o code section
  276.  
  277. throtl::save    <r0,r1>
  278.     tst    slowdo            ; really do this
  279.     beq    100$            ; no
  280.     tst    pauset            ; already a pause set ?
  281.     bne    100$            ; yes, skip this please
  282.     call    getuic            ; get the account number please
  283.     swab    r0            ; get group number in r0 please
  284.     cmpb    r0    ,slowgr        ; ignore this user ?
  285.     blos    100$            ; yes
  286.     calls    ttspeed    ,<#ttname>    ; get the current transfer rate
  287.     tst    r0            ; failure ?
  288.     beq    100$            ; skip this in that case
  289.     cmp    r0    ,slowbd        ; slow this user down ?
  290.     blos    100$            ; no
  291.     mov    r0    ,r1        ; yes, compute delay in seconds
  292.     clr    r0            ; based on baud/(cutoff*4). Thus
  293.     div    slowbd    ,r0        ; for 4800 baud, the delay would be
  294.     asr    r0            ; 1 second, reducing the effective
  295.     asr    r0            ; rate to 2400 baud
  296.     tst    r0            ; anything left?
  297.     bne    10$            ; nothing ?
  298.     inc    r0            ; always compute something
  299. 10$:    mov    r0    ,pauset        ; and save it
  300. 100$:    unsave    <r1,r0>
  301.     return
  302.  
  303.     global    <getuic    ,ttname    ,pauset>
  304.     
  305.  
  306.     .end
  307.