home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / k95 / 1120 / host.ksc < prev    next >
Text File  |  2020-01-01  |  32KB  |  1,162 lines
  1. ; File HOST.KSC - "Host mode" script for K-95.
  2. ;
  3. ; Assumes client is ANSI or VT100 terminal with 24 lines.
  4. ; Protocol operations use APC for automatic up/download,
  5. ; but don't require it.
  6. ;
  7. ;   Works on serial and TCP/IP Telnet connections.
  8. ;   Assumes the connection is already made.  Designed to be
  9. ;   started from HOSTMODE.KSC, which waits for the desired
  10. ;   type of connection to come in.
  11. ;
  12. ; Kermit 95 1.1.17 or later is required.
  13. ;
  14. ; Copyright (C) 1996, 1997, 1998, 1999, 2001
  15. ; Trustees of Columbia University in the City of New York.
  16. ; All rights reserved.   Authors:  F. da Cruz, C. Gianone, J. Altman.
  17. ;
  18. ; Version 1.00: February 1996 for 1.1.3.
  19. ; Version 1.01: 8 June 1997 for 1.1.12:
  20. ;  . Add "set transmit echo off".
  21. ;  . Change "clear device-and-input" to "clear input" in GETMENUITEM.
  22. ; Version 1.02:
  23. ;  . Fix problem with requests to send file groups
  24. ; Version 1.03: 9 July 1998 for 1.1.18
  25. ;  . Fix conflict with FAIL command added in 1.1.17
  26. ;  . Fix potential error if _mypriv is non-numeric
  27. ;  . Make sure Autodownload is OFF
  28. ;  . Add SET TELNET REMOTE-ECHO commands
  29. ; Version 1.04 2 September 1999 for 1.1.18
  30. ;  . Disable TELOPT commands
  31. ;  . Add support for Telnet Authentication
  32. ; Version 1.05 6 April 2000 for 1.1.20
  33. ;  . Change default locations to reference \v(exedir); not \v(startup)
  34. ; Version 1.06 11 Oct 2001 for 1.1.20
  35. ;  . Fixed FAIL to STOP rathr than EXIT and changed its name to BAIL.
  36. ;  . Modernized command continuation and macro definition syntax.
  37.  
  38. def _VERSION 1.06 ; Version of this script
  39.  
  40. ; MACRO DEFINITIONS
  41. ;
  42. ; HOSTLOG writes actions to the screen and to the transaction log.
  43. ; See subsequent redefinitions below.
  44. ;
  45. def HOSTLOG echo \v(time) - \fcontents(\%1)
  46.  
  47. ; BOXMSG prints an attention-getting message on the console screen.
  48. ;
  49. def BOXMSG {
  50.    asg \%9 \frepeat(=,\flen(\%1))
  51.    ec \%9, ec \%1, ec \%9
  52.    beep
  53. }
  54.  
  55. ; LOCK and UNLOCK are for use when updating the user database file,
  56. ; to prevent people from writing over each other's changes.
  57. ;
  58. def UNLOCK {
  59.   if not def _locked end 0
  60.   if exist \m(_lockfile) delete \m(_lockfile)
  61.   undef _locked
  62.   hostlog {Userfile UNLOCKED}
  63.   end 0
  64. }
  65.  
  66. def LOCK {
  67.   if def _locked end 1
  68.   if exist \m(_lockfile) end 1
  69.   open write \m(_lockfile)
  70.   if failure end 1
  71.   writeln file \m(_username)
  72.   if failure end 1
  73.   close write
  74.   if failure end 1
  75.   def _locked 1
  76.   hostlog {Userfile LOCKED}
  77.   end 0
  78. }
  79.  
  80. ; SPLIT and GETFIELDS are for parsing user database records.
  81. ;
  82. def SPLIT {
  83.   asg \%9 \findex(_,\%1)
  84.   asg _LEFT \fbreak(\%1,_)
  85.   asg _RIGHT \fsubstr(\%1,\%9+1)
  86. }
  87.  
  88. def GETFIELDS {
  89.   split {\%1}
  90.   asg U_ID \m(_LEFT)
  91.   split {\m(_RIGHT)}
  92.   asg U_PW \m(_LEFT)
  93.   split {\m(_RIGHT)}
  94.   asg U_PR \m(_LEFT)
  95.   split {\m(_RIGHT)}
  96.   asg U_NM \m(_LEFT)
  97.   split {\m(_RIGHT)}
  98.   asg U_AD \m(_LEFT)
  99.   split {\m(_RIGHT)}
  100.   asg U_TP \m(_LEFT)
  101.   split {\m(_RIGHT)}
  102.   asg U_EM \m(_LEFT)
  103. }
  104.  
  105. ; Make a variable: name is first arg, value is second.
  106. ;
  107. def MAKEVAR2 if def \%2 _assign \%1 \%2, else _assign \%1
  108.  
  109. ; Make a variable from single argument NAME=VALUE
  110. ; Creates variable called "_NAME" with definition "VALUE"
  111. ;
  112. def MAKEVAR {
  113.   if = \findex(=,\%1,1) 0 end
  114.   asg \%9 _\freplace(\%1,=,\32)
  115.   makevar2 \%9
  116. }
  117.  
  118. ; BAIL handles fatal errors
  119. ;
  120. define BAIL {
  121.   hostlog {In \v(cmdfile) at line \v(_line)...}
  122.   hostlog {Fatal error \v(errno) \v(errstring) - session closed}
  123.   beep
  124.   goto badend
  125. }
  126.  
  127. ; SAVEUSERDB saves the user database
  128. ;
  129. define SAVEUSERDB {
  130.   if exist \fdef(_userbak) del \fdef(_userbak)
  131.   rename \fdef(_userfile) \fdef(_userbak)
  132.   if failure hostlog {Warning - Failure to back up user database}
  133.   open write \fdef(_userfile)
  134.   xif failure {
  135.         hostlog {Can not open \fdef(_userfile)}
  136.         UNLOCK
  137.         end 1 
  138.   }
  139.   for \%i 1 \&u[0] 1 {
  140.     writeln file \&u[\%i]
  141.     xif failure {
  142.       hostlog {Error writing record \%i to \fdef(_userfile)}
  143.       hostlog {Old version preserved as \fdef(_userbak)}
  144.       break
  145.     }
  146.   }
  147.   close write
  148.   asg \%9 \v(status)
  149.   if not = \%9 0 hostlog {WARNING - Failed to close \fdef(_userfile)}
  150.   else hostlog {\fdef(_userfile) saved: \&u[0] records}
  151.   UNLOCK
  152.   end \%9
  153. }
  154.  
  155. ; CONFIGURATION: Defaults in case the config file (HOST.CFG) gets lost...
  156. ;
  157. asg _maxusers 100            ; Maximum number of users in database
  158. asg _inactivity 1800            ; Logged-in inactivity limit (seconds)
  159. asg _logintime 300            ; Inactivity limit while logging in
  160. asg _anonok 1                ; Anonymous logins OK (0 = not OK)
  161. asg _logging 1                ; Logging enabled (0 = skip logging)
  162. asg _dlincoming 0            ; OK to download from INCOMING dir
  163. asg _msgmax 200                ; Longest message size (lines)
  164. asg _protocol kermit            ; Default file transfer protocol
  165. asg _xfermode binary            ; Default file transfer mode
  166. asg _owner THE PROPRIETOR        ; PC owner's name or company
  167. asg _herald Welcome to K-95 Host Mode    ; Main screen title
  168. asg _public   \v(startup)PUBLIC        ; Directory users can get files from
  169. asg _incoming \v(startup)INCOMING    ; Directory that users can send file to
  170. asg _logdir   \v(startup)LOGS        ; Directory for host-mode logs
  171. asg _usertree \v(startup)USERS        ; Root of user directory tree
  172. asg _tmpdir   \v(tmpdir)        ; Directory for temp files
  173. if not def _tmpdir asg _tmpdir \v(exedir)TMP
  174. asg _userfile \m(_usertree)/USERS.DAT     ; User database file
  175. asg _greeting \m(_usertree)/GREETING.TXT ; Message/greeting text filename
  176. asg _helpfile \m(_usertree)/HOSTMODE.TXT ; Host-mode help file
  177. asg _msgfile  \m(_usertree)/MESSAGES.TXT ; Messages for proprietor
  178.  
  179. ; Now read the configuration file.
  180. ; Note that the name and subdirectory are hardwired.
  181. ;
  182. asg _configfile \freplace(\v(exedir)scripts/host.cfg,/,\\)
  183. asg _mypriv 0
  184.  
  185. if not exist \m(_configfile) forward noconfig
  186. open read \m(_configfile)
  187. if failure forward noconfig
  188. while true { read \%a, if failure break, makevar \%a }
  189.  
  190. :NOCONFIG
  191.  
  192. ; END OF CONFIGURATION SECTION
  193.  
  194. dcl \&u[\m(_maxusers)]
  195.  
  196. if not def _lockfile asg _lockfile \m(_usertree)/USERS.LCK
  197.  
  198. if not exist \m(_userfile) -
  199.   if not eq "\m(_anonok)" "1" -
  200.     stop 1 Fatal - User database not found and guest logins are disabled.
  201.  
  202. asg _userbak \freplace(\m(_userfile),.DAT,.BAK)    ; Name of backup file
  203.  
  204. ; CD to where the user directories are.
  205. ;
  206. cd \m(_usertree)
  207. if failure stop 1 Fatal - Can't change directory to "\m(_usertree)"
  208.  
  209. ; And then CD to its parent.
  210. ;
  211. cd ..
  212. if failure stop 1 Fatal - Can't change directory to "\m(_usertree)/.."
  213.  
  214. asg _startdir \v(dir)            ; Host-mode "home" directory.
  215.  
  216. ; Create needed directories if they don't exist.
  217. ;
  218. if not directory \m(_incoming) mkdir \m(_incoming)
  219. if not directory \m(_incoming) stop 1 Fatal - no INCOMING directory
  220.  
  221. if not directory \m(_public) mkdir \m(_public)
  222. if not directory \m(_public) stop 1 Fatal - no PUBLIC directory
  223.  
  224. if not directory \m(_usertree) mkdir \m(_usertree)
  225. if not directory \m(_usertree) stop 1 Fatal - no USERS directory
  226.  
  227. if not directory \m(_tmpdir) mkdir \m(_tmpdir)
  228. if not directory \m(_tmpdir) stop 1 Fatal - no TMP directory
  229.  
  230. if eq "\m(_logging)" "1" -
  231.   if not dir \m(_logdir) mkdir \m(_logdir) ; Not fatal if this fails
  232.  
  233. if exist \m(_msgfile) boxmsg {You have messages in \m(_msgfile)!}
  234.  
  235. ; SETTINGS...
  236. ;
  237. set input echo off            ; Keep host PC screen clean
  238. set exit warning off            ; ...
  239. set file display quiet            ; ...
  240. set case off                ; Ignore case in string comparisons 
  241. set delay 1                ; Delay in starting file transfers
  242. set file type binary            ; Transfer mode is binary by default
  243. set transmit prompt 0            ; No line turnaround on TRANSMIT
  244. set transmit linefeed on        ; Keep linefeeds when transmitting
  245. set transmit echo off                   ; No echo during TRANSMIT
  246. set file char cp437            ; For PC-format text files
  247.  
  248. set file names converted        ; No weird stuff in filenames
  249. set receive pathnames off        ; Strip pathnames from incoming files
  250. set send pathnames off            ; and outbound pathnames too
  251. set file collision overwrite        ; Overwrite incoming files by default
  252.  
  253. set input autodownload off
  254. set terminal autodownload off
  255. if >= \v(xversion) 1118 { set telnet remote-echo off }
  256.  
  257. if < \v(xversion) 1118 {
  258.  ; If we are a Telnet server we need to control the echoing ourselves.
  259.  ;
  260.  if not = \findex(tcp,\v(connection),1) 1 forward NOTELOPT
  261.  ;
  262.  ; Ex-post-facto Telnet "negotiations" to undo whatever might have been
  263.  ; negotiated already.  K95 normally is a client, but now it is a server.
  264.  ;
  265.  telopt will echo            ; I must echo
  266.  if failure bail            ; Make sure this does not fail
  267.  telopt dont echo            ; You must not echo
  268.  telopt will sga            ; Suppress Go-Ahead
  269.  telopt wont ttype            ; No terminal type negotiations
  270.  telopt wont naws            ; No screen-size negotiations
  271. }
  272.  
  273. :NOTELOPT
  274. def ERROR msg {\%1}, sleep 2, def _status 1, goto main
  275. def FATAL msg {Fatal - {\%1}}, sleep 2, fail
  276.  
  277. hostlog {\v(date) - Start host script \v(cmdfil)}
  278. hostlog {Current directory: \freplace(\v(dir),\\,/)}
  279.  
  280. ; Macros for screen formatting using VT100/ANSI escape sequences
  281.  
  282. define clr output \27[H\27[2J, if failure bail   ; Clear screen
  283. define cur output \27[\%1;\%2H, if failure bail  ; Position the cursor
  284. define atp cur \%1 \%2, out \%3, if failure bail ; Print text at cursor pos
  285. define cleol out \27[K, if failure bail          ; Clear to end of line
  286.  
  287. ; Returns basename of DOS/Windows-format filename argument \%1;
  288. ; that is, the filename stripped of disk letter and/or directory path, if any.
  289. ;
  290. define BASENAME {
  291.   asg \%9 \frindex(:,\%1)
  292.   asg \%8 \frindex(/,\%1)
  293.   asg \%7 \frindex(\\,\%1)
  294.   asg \%6 \fmax(\%9,\%8)
  295.   asg \%6 \fmax(\%7,\%6)
  296.   return \fsubstr(\%1,\%6+1)
  297. }
  298.  
  299. ; Print message in message area - line \%M column \%C
  300. define MSG cur \%M \%C, cleol, if def \%1 out \fcont(\%1)
  301.  
  302. ; The next two are used with "Leave a message".
  303. ; \%k is the message line number, global, don't use for anything else.
  304. ;
  305. def ADDLINE incr \%k, asg \&a[\%k] \fcontents(\%1)
  306. def NEWSCREEN def \%L 1, clr
  307.  
  308. ; Erases a character on the input line and from the input variable \%n.
  309. ;
  310. define BS {
  311.   if not > \flen(\%n) 0 end 0
  312.   asg \%n \fsubstr(\%n,1,\flen(\%n)-1)
  313.   decr \%p, out \27[D, cleol, end 0
  314. }
  315.  
  316. ; GETMENUITEM reads a number into \%n, using the echo line, \%L.
  317. ; The argument (\%1) is the label to jump to if the menu needs to be repainted.
  318. ; The minimum value is 1, the maximum value is the second argument, \%2.
  319. ; The prompt is "Enter choice: ".
  320. ;
  321. define GETMENUITEM {
  322.   atp \%L \%C {Enter choice: }
  323. :NEW
  324.   asg \%p \feval(\%C+14)
  325.   asg \%q \%p
  326.   def \%n
  327. :INLOOP1
  328.   clear input
  329.   cur \%L \%p
  330.   cleol
  331.   input \m(_inactivity)
  332.   if failure bail
  333.   if eq "" "\v(inchar)" goto inloop1
  334.   asg \%9 \fcode(\v(inchar))
  335.   if = \%9   9 asg \%9 32
  336.   if = \%9 127 asg \%9 8
  337.   if = \%9   8 { bs, goto inloop1 }
  338.   if = \%9  21 { cur \%L \%q, cleol, asg \%p \%q, asg \%n, goto inloop1 }
  339.   if = \%9   3 goto main
  340.   if = \%9  12 goto \%1
  341.   if not < \%9 32 forward graphic
  342.   if not def \%n goto inloop1
  343.   forward gotit
  344. :GRAPHIC
  345.   atp \%L \%p \v(inchar)
  346.   incr \%p
  347.   if eq \%9 32 { if def \%n forward GOTIT, else goto inloop1 }
  348.   if not numeric \v(inchar) { msg {"\v(inchar)" - Not a number}, goto new }
  349.   if not def \%n asg \%n 0
  350.   asg \%n \feval(10 * \%n + \v(inchar))
  351.   msg
  352.   goto inloop1
  353. :GOTIT
  354.   msg {Your choice: \%n}
  355.   if not def \%n goto \%1
  356.   if not numeric \%n goto \%1
  357.   if > \%n 0 if not > \%n \%2 end 0
  358.   msg {\%n - Out of range}
  359.   goto new
  360. }
  361.  
  362. ; INTEXT reads a line of text from user on the input line, \%L, allows editing
  363. ; with Backspace or Del (erase characters), Ctrl-U (erase line), etc.
  364. ; Can be interrupted with Ctrl-C if _ctrlc is defined (it should be defined
  365. ; as a help string to be printed).
  366. ;
  367. ; Terminates on space or any control character except BS, Del, or Ctrl-U.
  368. ; The techniques used for reading and echoing characters are designed to work
  369. ; on both serial and Telnet connections, even whe Telnet echoing is
  370. ; misnegotiated.
  371. ;
  372. ; Argument 1 is the input (echo) line number.
  373. ; Argument 2 is the prompt.
  374. ; Argument 3 is 32 to break on space or less, 31 to break only on control 
  375. ;  chars (use 32 to read a word, use 31 to read a line of text).
  376. ; Argument 4, if included, is the timeout value.
  377. ; Argument 5, if included, is a char to echo in place of what was typed.
  378. ;
  379. ; Returns:
  380. ;   0 on success with \%n set to the text that was input.
  381. ;   1 if Ctrl-C was typed
  382. ;
  383. define INTEXT {
  384.   if not def \%3 asg \%3 32
  385.   if not def \%4 asg \%4 \m(_inactivity)
  386.   if def \%5 if > \flen(\%5) 1 asg \%5 \fsubstr(\%5,1,1)
  387.   def \%n
  388.   asg \%L \%1
  389.   asg \%p \feval(\flen(\%2)+\%C)
  390.   asg \%q \%p
  391.   atp \%L \%C {\%2}
  392.   if def _ctrlc atp \feval(\%L+1) \%C {\m(_ctrlc)}
  393. :INLOOP2
  394.   cur \%L \%p
  395.   cleol
  396.   input \%4
  397.   if failure bail
  398.   if eq "\v(inchar)" "" goto inloop2
  399.   asg \%9 \v(inchar)
  400.   asg \%8 \fcode(\v(inchar))
  401.   if = \%8 3 if def _ctrlc end 1
  402.   if = \%8   9 { asg \%8 32, asg \%9 \32 }
  403.   if = \%8   8 { bs, goto inloop2 }
  404.   if = \%8 127 { bs, goto inloop2 }
  405.   if = \%8  21 {
  406.     cur \%L \%q, cleol, asg \%p \%q, asg \%n, goto inloop2
  407.   }
  408.   if > \%8 \%3 { 
  409.       asg \%n \fcontents(\%n)\fcontents(\%9)
  410.       if def \%5 atp \%L \%p \%5
  411.       else atp \%L \%p \fcont(\%9)
  412.       incr \%p
  413.       goto inloop2
  414.   }
  415.   if eq "" "\%n" goto inloop2
  416.   end 0
  417. }
  418.  
  419. ; Displays a text file on the user's screen
  420. ;
  421. def DISPLAY {
  422.   hostlog {Typing \%1}
  423.   asg \%9 \v(ftype)
  424.   set file type text
  425.   output \13\10\10
  426.   transmit \%1
  427.   asg _status \v(status)
  428.   set file type \%9
  429.   out \10\13Use scrollback to view any text that scrolled off the screen.
  430.   out \10\13Press any key to continue...
  431.   input \m(_inactivity)
  432.   end 0
  433. }
  434.  
  435. ;+------------------------------------------------------------------------
  436. ; LOGIN procedure
  437. ;
  438.  
  439. asg \%C 1     ; Left margin column for login procedure.
  440. asg \%M 6     ; Row for messages.
  441. undef _ctrlc  ; Ctrl-C disabled during login process!
  442. undef _locked
  443.  
  444. hostlog {Connection from \v(line)}
  445. clr
  446.  
  447. atp 1 1 {K-95 Login - Initializing...}
  448.  
  449. if < \v(xversion) 1118 { 
  450.   msleep 2000                ; Wait for TELNET option replies
  451.   clear device-buffer            ; and then clear them out
  452. }
  453.  
  454. hostlog {Auth State = [\v(authstate)]}
  455. hostlog {Auth Name  = [\v(authname)]}
  456. hostlog {Auth Type  = [\v(authtype)]}
  457. hostlog {User name  = [\v(user)]}
  458.  
  459. if eq "\v(authstate)" "valid" {
  460.   asg _username \v(user)
  461.   def ok 0
  462.   if not exist \m(_userfile) forward AUTHBAD
  463.   open read \m(_userfile)
  464.   if failure forward AUTHBAD
  465. :AUTHLOOP
  466.   read \%a
  467.   if failure forward AUTHDONE
  468.   getfields {\%a}
  469.   if not eq "\m(U_ID)" "\m(_username)" goto AUTHLOOP
  470.   def ok 1
  471. :AUTHDONE
  472.   close read
  473.   if > \m(ok) 0 forward AUTHGOOD
  474. :AUTHBAD
  475.   hostlog {Access denied "\m(_username)"}
  476.   undef _password
  477.   if count goto again
  478.   msg {Access denied - hanging up}
  479.   incr \%M
  480.   msg
  481.   hostlog {Invalid user - access denied}
  482.   bail
  483. :AUTHGOOD
  484.   undef _password
  485.   asg _myname \fdef(U_NM)
  486.   asg _mypriv \m(U_PR)
  487.   if not numeric \m(_mypriv) asg _mypriv 0
  488.   msg {\m(_username) authenticated by \v(authtype)}
  489.   beep
  490.   if >= \v(xversion) 1118 { set telnet remote-echo on }
  491.   undef noecho
  492.   forward LOGGEDIN
  493. }
  494.  
  495. if eq "\v(authstate)" "user" {
  496.   asg _username \v(user)
  497.   forward GETPASSWD
  498. }
  499.  
  500. set count 3                ; Allow three tries to log in
  501. :AGAIN                    ; Login retry loop
  502. clr
  503. atp 1 1 {K-95 Login}
  504. if < \v(count) 3 { msg {Access denied}, sleep 3 }
  505. def \%L 1
  506. define noecho
  507. if >= \v(xversion) 1118 { set telnet remote-echo on }
  508. clear device-buffer            ; Don't allow typeahead
  509. intext 3 {Username: } 32 90
  510. if failure bail
  511. asg _username \%n
  512. if not eq "\m(_anonok)" "1" forward GETPASSWD
  513. if not eq "\m(_username)" "guest" forward GETPASSWD
  514.  
  515. msg                    ; GUEST user
  516. asg _myname {Anonymous Guest}
  517. asg _mypriv 0
  518. msg
  519. beep
  520. if >= \v(xversion) 1118 { set telnet remote-echo on }
  521. undef noecho
  522. forward LOGGEDIN
  523.  
  524. :GETPASSWD
  525. def noecho on
  526. if >= \v(xversion) 1118 { set telnet remote-echo off }
  527. clear device-buffer
  528. intext 4 {Password: } 32 90 *
  529. if failure bail
  530. asg _password \f.oox(\%n)
  531. asg \%n
  532.  
  533. :CHECKPASSWD
  534.   def ok 0
  535.   if not exist \m(_userfile) forward BAD
  536.   open read \m(_userfile)
  537.   if failure forward BAD
  538. :PWLOOP
  539.   read \%a
  540.   if failure forward PWDONE
  541.   getfields {\%a}
  542.   if not eq "\m(U_ID)" "\m(_username)" goto PWLOOP
  543.   if not eq "\m(U_PW)" "\m(_password)" goto PWLOOP
  544.   def ok 1
  545. :PWDONE
  546.   close read
  547.   if > \m(ok) 0 forward good
  548. :BAD
  549.   hostlog {Access denied "\m(_username)"}
  550.   undef _password
  551.   if count goto again
  552.   msg {Access denied - hanging up}
  553.   incr \%M
  554.   msg
  555.   hostlog {Incorrect password - access denied}
  556.   bail
  557. :GOOD
  558.   undef _password
  559.   asg _myname \fdef(U_NM)
  560.   asg _mypriv \m(U_PR)
  561.   if not numeric \m(_mypriv) asg _mypriv 0
  562.   msg
  563.   beep
  564.   if >= \v(xversion) 1118 { set telnet remote-echo on }
  565.   undef noecho
  566.  
  567. ;+------------------------------------------------------------------------+
  568. ; Get here when logged in.
  569.  
  570. :LOGGEDIN
  571.  
  572. ; Create Transaction log with unique name "<username>_<julian-date>_<time>.log"
  573. ;
  574. if eq "\m(_logging)" "1" {
  575.   log transactions \m(_logdir)/\m(_username)_\v(ndate)_\v(ntime).log
  576.   if failure hostlog {Warning - can't create log file}
  577.   else def HOSTLOG { echo \v(time) - \fcont(\%1)
  578.     writeln trans \v(time) - \fcont(\%1) }
  579. }
  580. hostlog {Login by \m(_username) (\m(_myname))}
  581.  
  582. if exist \m(_greeting) display \m(_greeting)
  583.  
  584. :CHKANON ; Check for anonymous GUEST login
  585.   if not eq "\m(_username)" "guest" forward USERCD
  586.   cd \m(_public)
  587.   asg _current PUBLIC
  588.   undef _userdir
  589.   forward START
  590.  
  591. :USERCD ; Create user's directory if necessary and then CD to it.
  592.  
  593. asg _userdir \m(_usertree)/\m(_username)
  594. if not directory \m(_userdir) {
  595.   hostlog {Creating \m(_userdir)}
  596.   mkdir \m(_userdir)
  597.   if failure fatal {Unable to create your directory}
  598. }
  599. cd \m(_userdir)
  600. if failure fatal {Unable to access your directory}
  601.  
  602. asg _current USER
  603.  
  604. :START
  605.   dcl \&s[2]            ; Status messages
  606.   def \&s[0] OK
  607.   def \&s[1] FAILED
  608.   def \&s[2] UNKNOWN
  609.  
  610.   dcl \&p[5]            ; Protocol names
  611.   def \&p[1] kermit
  612.   def \&p[2] zmodem
  613.   def \&p[3] ymodem
  614.   def \&p[4] ymodem-g
  615.   def \&p[5] xmodem
  616.  
  617.   define \%C 20 ; Left margin column for menu
  618.   hostlog {Enter main menu}
  619.   undef _csave
  620.   undef _inmail
  621.   undef _status
  622.   set protocol \m(_protocol)
  623.   set file type \m(_xfermode)
  624.  
  625.   def _priv_cd  1
  626.   def _priv_dos 2
  627.   def _idle_limit (none)
  628.   if not numeric _inactivity asg _inactivity 1800
  629.   if > \m(_inactivity) 0 asg _idle_limit \m(_inactivity)
  630.  
  631. :MAIN
  632.   if def _locked unlock
  633.   if def _inmail { hostlog {Message canceled}, undef _inmail }
  634.   dcl \&a[0]
  635.   def _ctrlc (Ctrl-C to return to main menu) ; Ctrl-C enabled now
  636.   if def _csave { asg \%C \m(_csave), def _csave } ; Left margin
  637.  
  638. clr
  639. atp  1 \%C {\m(_herald) V\m(_VERSION)}
  640. atp  3 \%C {Current directory: \freplace(\v(dir),\\,/)}
  641. atp  4 \%C {Protocol: \v(protocol), Transfer mode: \fcaps(\v(ftype))}
  642. if exist \m(_usertree)/\m(_username).MSG -
  643. atp  5 \%C {Message(s) waiting...}
  644. else atp  5 \%C {Idle limit: \m(_idle_limit) sec -- Choices:}
  645. atp  7 \%C { 1 - Change protocol}
  646. atp  8 \%C { 2 - Change transfer mode}
  647. atp  9 \%C { 3 - Change directory}
  648. atp 10 \%C { 4 - List files}
  649. atp 11 \%C { 5 - Download files}
  650. atp 12 \%C { 6 - Upload files}
  651. atp 13 \%C { 7 - View a file}
  652. atp 14 \%C { 8 - Delete files}
  653. atp 15 \%C { 9 - Read messages}
  654. atp 16 \%C {10 - Leave a message}
  655. atp 17 \%C {11 - Change password}
  656. atp 18 \%C {12 - Help}
  657. atp 19 \%C {13 - Logout}
  658. if not > \m(_mypriv) 1 forward NODOS
  659. atp 20 \%C {14 - Execute a DOS command}
  660. if def _status -
  661. atp 24 \%C {Last command: \&s[\m(_status)]}
  662. asg \%H 14             ; Highest menu item
  663. asg \%L 22             ; Menu input line
  664. forward getmenu
  665. :NODOS                 ; DOS commands not allowed
  666. if def _status -
  667. atp 23 \%C {Last command: \&s[\m(_status)]}
  668. asg \%H 13
  669. asg \%L 21
  670. :GETMENU
  671. asg \%M \feval(\%L+1)  ; Message line
  672. getmenuitem main \%H   ; Get user's choice
  673. if eq "" "\%n| {
  674.         hostlog {Undefined LBL_ value}
  675.         bail
  676. }
  677. forward LBL_\%n        ; Go forward and handle it
  678.  
  679. ;+------------------------------------------------------------------------+
  680. ; Host mode actions
  681.  
  682. :LBL_1 ; PROTOCOL
  683. clr
  684. atp  4 \%C {SELECT PROTOCOL}
  685. atp  6 \%C {Current protocol: \v(protocol)}
  686. atp  8 \%C {Choices:}
  687. atp 10 \%C {1 - Kermit}
  688. atp 11 \%C {2 - ZMODEM}
  689. atp 12 \%C {3 - YMODEM}
  690. atp 13 \%C {4 - YMODEM-G}
  691. atp 14 \%C {5 - XMODEM}
  692. atp 15 \%C {6 - Return to main menu}
  693.  
  694. asg \%L 17             ; Menu input line
  695. asg \%M \feval(\%L+2)  ; Message line
  696. getmenuitem lbl_1 6
  697. if not = \%n 6 set protocol \&p[\%n]
  698. asg _status \v(status)
  699. goto main
  700.  
  701. :LBL_2 ; TRANSFER MODE
  702. clr
  703. atp  8 \%C {SELECT TRANSFER MODE}
  704. atp 10 \%C {Current mode: \v(ftype)}
  705. atp 12 \%C {Choices:}
  706. atp 14 \%C {1 - Binary}
  707. atp 15 \%C {2 - Text}
  708. atp 16 \%C {3 - Return to main menu}
  709.  
  710. asg \%L 18             ; Menu input line
  711. asg \%M \feval(\%L+2)  ; Message line
  712. getmenuitem lbl_2 3
  713. if = \%n 1 set file type binary
  714. else if = \%n 2 set file type text
  715. asg _status \v(status)
  716. goto main
  717.  
  718. :LBL_5 ; DOWNLOAD
  719. clr
  720. if > \m(_mypriv) 0 forward DLOK
  721. if eq "\m(_dlincoming)" "1" forward DLOK
  722. if not eq "\m(_current)" "INCOMING" forward DLOK
  723. error {Sorry - Read access to INCOMING directory not allowed.}
  724. :DLOK
  725. atp  4 \%C {DOWNLOAD FILES}
  726. atp  6 \%C {Protocol:      \v(protocol)}
  727. atp  7 \%C {Transfer mode: \v(ftype)}
  728. atp  9 \%C {Type a single file specification.}
  729. if eq "\v(protocol)" "XMODEM" forward DLNAME
  730. atp 11 \%C {To select multiple files:}
  731. atp 12 \%C {include * and/or ? in the filename.}
  732. :DLNAME
  733. intext \%L {File(s) to download: }
  734. if failure goto main
  735. if not def \%n goto main
  736. asg \%n \fexec(basename \%n)
  737. if not > \ffiles(\%n) 0 error {\%n - File not found}
  738. hostlog {Sending \%n}
  739. if eq "\v(protocol)" "kermit" apc receive
  740. msg {Please escape back and initiate a \v(protocol) RECEIVE...}
  741. sleep 1
  742. send \%n
  743. asg _status \v(status)
  744. if = \m(_status) 0 hostlog {Send OK, \v(cps) CPS}
  745. else hostlog {Send failed}
  746. goto main
  747.  
  748. :LBL_6 ; UPLOAD
  749. clr
  750. if > \m(_mypriv) 0 forward UPLOADOK
  751. if not eq "\m(_current)" "PUBLIC" forward UPLOADOK
  752. atp 4 \%C {Sorry - no uploading to the PUBLIC directory.}
  753. atp 5 \%C {Please change to the INCOMING directory or to}
  754. atp 6 \%C {your own home directory prior to uploading.}
  755. sleep 2
  756. asg _status 1
  757. goto main
  758. :UPLOADOK
  759. atp 4 \%C {UPLOAD FILES}
  760. atp 6 \%C {Protocol:      \v(protocol)}
  761. atp 7 \%C {Transfer mode: \v(ftype)}
  762. intext \%L {File(s) to upload: }
  763. if failure goto main
  764. if not def \%n goto main
  765. if not eq "\v(protocol)" "kermit" forward XYZMODEM
  766. apc server
  767. atp 12 \%C {Please escape back and enter SERVER mode...}
  768. sleep 1
  769. beep info
  770. hostlog {Receiving \%n in \freplace(\v(dir),\\,/)}
  771. get \%n
  772. asg _status \v(status)
  773. if = \m(_status) 0 hostlog {Get OK, \v(cps) CPS}
  774. else hostlog {Get failed}
  775. sleep 1
  776. finish
  777. goto main
  778. :XYZMODEM
  779. atp 12 \%C {Please return to your client software and instruct}
  780. atp 13 \%C {it to send \%n using \v(protocol) protocol.}
  781. receive
  782. asg _status \v(status)
  783. goto main
  784.  
  785. :LBL_7 ; TYPE
  786. clr
  787. if > \m(_mypriv) 0 forward TYPEOK
  788. if not eq "\m(_current)" "INCOMING" forward TYPEOK
  789. if eq "\m(_dlincoming)" "1" forward TYPEOK
  790. error {Sorry - Read access to the INCOMING directory not allowed.}
  791. :TYPEOK
  792. atp 8 \%C {TYPE A FILE}
  793. intext \%L {File to type: }
  794. if failure goto main
  795. asg \%n \fexec(basename \%n)
  796. if not exist \%n error {\%n - File not found}
  797. display \%n
  798. goto main
  799.  
  800. :LBL_8 ; DELETE
  801. clr
  802.  
  803. if > \m(_mypriv) 0 forward DELOK
  804. if eq "\m(_current)" "USER" forward DELOK
  805. error {Sorry - You may delete files only in your own directory.}
  806. :DELOK
  807. atp 8 \%C {DELETE FILES}
  808. intext \%L {File(s) to delete: }
  809. if failure goto main
  810. asg \%n \fexec(basename \%n)        ; Strip disk and directory
  811. if not > \ffiles(\%n) 0 error {\%n - Not found}
  812. delete \%n
  813. asg _status \v(status)
  814. goto main
  815.  
  816. :LBL_4 ; DIRECTORY
  817. clr
  818. if > \m(_mypriv) 0 forward DIROK
  819. if eq "\m(_dlincoming)" "1" forward DIROK
  820. if not eq "\m(_current)" "INCOMING" forward DIROK
  821. error {Sorry - Read access to the INCOMING directory not allowed.}
  822. :DIROK
  823. atp  8 \%C {VIEW DIRECTORY LISTING}
  824. hostlog {Sending directory listing}
  825. cur 10 1
  826. asg _tmpfile \m(_tmpdir)K_\v(ntime).TMP
  827. run dir > \freplace(\m(_tmpfile),/,\\)
  828. display \m(_tmpfile)
  829. delete \m(_tmpfile)
  830. goto main
  831.  
  832. :LBL_3 ; CD
  833. clr
  834. atp   8 \%C {CHANGE DIRECTORY}
  835. atp  10 \%C {Current directory: \freplace(\v(dir),\\,/)}
  836. atp  12 \%C {Choices:}
  837. atp  14 \%C {1 - My home directory (read/write only by me)}
  838. atp  15 \%C {2 - The PUBLIC directory (everybody can read it)}
  839. if eq "\m(_dlincoming)" "1" -
  840. atp  16 \%C {3 - The INCOMING directory (everybody can read and write)}
  841. else -
  842. atp  16 \%C {3 - The INCOMING directory (everybody can write)}
  843.  
  844. if > \m(_mypriv) 0 -
  845. atp  17 \%C {4 - A specific directory}
  846. atp  18 \%C {5 - Return to main menu}
  847.  
  848. asg \%L 20             ; Menu input line
  849. asg \%M \feval(\%L+2)  ; Message line
  850.  
  851. getmenuitem LBL_3 5    ; Repaint menu at LBL_3, 5 items in menu
  852. forward cd_\%n         ; Dispatch to chosen menu item
  853.  
  854. :CD_1 ; CD to home directory
  855. if not def _userdir goto main        ; Not for anonymous users
  856. cd \m(_userdir)                ; Real user, CD to own directory
  857. asg _status \v(status)            ; Remember status
  858. enable send                ; Uploads are allowed
  859. set file collision ov            ; OK to overwrite files
  860. asg _current USER
  861. goto main
  862.  
  863. :CD_2 ; CD to PUBLIC directory
  864. cd \m(_public)                ; Everybody can do this
  865. asg _status \v(status)
  866. if < \m(_mypriv) 1 disable send        ; Sending to here not allowed
  867. else enable send
  868. set file collision ov            ; Write over files on uploads
  869. asg _current PUBLIC
  870. goto main
  871.  
  872. :CD_3 ; CD to INCOMING directory
  873. cd \m(_incoming)            ; Everone can come here
  874. asg _status \v(status)
  875. set file collision ov            ; Overwrite files on upload
  876. asg _current INCOMING
  877. enable send                ; It's always OK to upload
  878. goto main
  879.  
  880. ; CD to a given directory.
  881. ; Note the use of \fcontents() to prevent overevaluation of backslashes.
  882. ;
  883. :CD_4 ; CD to a specific directory
  884. if not > \m(_mypriv) 0 error {Sorry - insufficient privilege}
  885. intext \%L {Enter directory name: }
  886. if failure goto LBL_3
  887. if not def \%n goto LBL_3
  888. if not dir \fcont(\%n) error {\%n - not a directory}
  889. cd \fcont(\%n)
  890. asg _status \v(status)
  891. if > \m(_status) 0 error {Failure to change directory to "\fcont(\%n)"}
  892. set file collision backup        ; Overwrite would be dangerous here!
  893. asg _current SPECIAL            ; But RENAME is too confusing...
  894. enable send                ; I'm privileged so I can upload.
  895. goto main
  896.  
  897. :CD_5
  898. goto main
  899.  
  900. :LBL_9 ; CHECK / READ MESSAGES
  901. clr
  902. if not exist \m(_usertree)/\m(_username).MSG forward NOMSGS
  903. display \m(_usertree)/\m(_username).MSG
  904.  
  905. :MSGDISP
  906. clr
  907. atp  8 \%C {MESSAGE DISPOSITION}
  908. atp 10 \%C {Choices:}
  909. atp 12 \%C {1 - Redisplay}
  910. atp 13 \%C {2 - Delete}
  911. atp 14 \%C {3 - Save in MESSAGES.TXT}
  912. atp 15 \%C {4 - Download}
  913. atp 16 \%C {5 - Return to main menu}
  914. asg \%L 18             ; Menu input line
  915. asg \%M \feval(\%L+2)  ; Message line
  916. getmenuitem msgdisp 5
  917. forward MSG_\%n
  918. :MSG_1
  919.   goto lbl_9
  920. :MSG_2
  921.   delete \m(_usertree)/\m(_username).MSG
  922.   asg _status \v(status)
  923.   goto main
  924. :MSG_3
  925.   asg \%9 \freplace(\v(dir),\\,/)
  926.   cd \m(_usertree)
  927.   run copy \m(_username)\\MESSAGES.TXT+\m(_username).MSG -
  928.     \m(_username)\\MESSAGES.TXT
  929.   asg _status \v(status)
  930.   cd \%9
  931.   if = \m(_status) 0 delete \m(_usertree)/\m(_username).MSG
  932.   goto main
  933. :MSG_4
  934.   hostlog {Sending \m(_usertree)/\m(_username).MSG}
  935.   if eq "\v(protocol)" "kermit" apc receive
  936.   msg {Please escape back and initiate a \v(protocol) RECEIVE...}
  937.   asg \%9 \v(ftype)
  938.   set file type text
  939.   sleep 1
  940.   send \m(_usertree)/\m(_username).MSG
  941.   asg _status \v(status)
  942.   set file type \%9
  943.   if = \m(_status) 0 {
  944.     hostlog {Send OK, \v(cps) CPS}
  945.     delete \m(_usertree)/\m(_username).MSG
  946.   } else {
  947.     hostlog {Send failed}
  948. }
  949. :MSG_5
  950. goto main
  951.  
  952. :NOMSGS
  953. atp 4 \%C {No messages for \m(_username)}
  954. sleep 2
  955. goto main
  956.  
  957. :LBL_10 ; LEAVE A MESSAGE
  958. def _inmail 1
  959. def _ctrlc (Ctrl-C to cancel message)
  960. dcl \&a[\m(_msgmax)+5]
  961. def \%k 0 ; Line number of entire message - see addline
  962.  
  963. clr
  964. addline {Date: \v(date) \v(time)}
  965. addline {From: \m(_username) (\m(_myname))}
  966. atp 4 \%C {LEAVE A MESSAGE FOR \m(_owner)}
  967. asg _csave \%C
  968. def \%C 1
  969. def \%L 6
  970. intext \%L {Subject: } 31
  971. if failure goto main
  972. asg _subject \fcontents(\%n)
  973. addline {Subject: \fcontents(\%n)}
  974. addline {}
  975. cur 7 1
  976. cleol
  977. cur 8 1
  978. cleol
  979. out {Type the message now.  To make a blank line, enter a space by itself.}
  980. cur 9 1
  981. cleol
  982. out {Maximum lines: \m(_msgmax).  Type a period by itself on a line to finish.}
  983. def \%L 10
  984. cur \%L 1
  985. cleol
  986. def \%i 0   ; Line number of message body
  987. set count \m(_msgmax)
  988. :MSGLOOP
  989.   if = \%L 22 newscreen
  990.   incr \%L
  991.   incr \%i
  992.   intext \%L {\flpad(\%i,3,0)> } 31
  993.   if failure goto main
  994.   addline {\fcontents(\%n)}
  995.   if eq "\%n" "." forward msgdone
  996.   if count goto msgloop
  997.   atp %\L 1 {Maximum lines exceeded}
  998. :MSGDONE
  999. incr \%L
  1000. cur \%L 1
  1001. cleol
  1002. incr \%L
  1003. if > \%L 22 newscreen
  1004. asg \%i 999
  1005.  
  1006. :MSGCFM ; Confirm the message
  1007.   atp \%L 1 {Type Ctrl-C to cancel or Press space bar to send: }
  1008.   input \m(_inactivity)
  1009.   if failure bail
  1010.   asg \%i \fcode(\v(inchar))
  1011.   if = \%i 3 goto main
  1012.   if = \%i 32 forward MSGSEND
  1013.   goto MSGCFM
  1014.  
  1015. :MSGSEND ; Send the message
  1016. open append \m(_msgfile)
  1017. if failure error {Sorry - messages not available now}
  1018. for \%i 1 \%k 1 {
  1019.   writeln file \fcontents(\&a[\%i])
  1020. }
  1021. close append
  1022. asg _status \v(status)
  1023. if = \m(_status) 0 forward MSGOK
  1024. hostlog {Problem sending message}
  1025. msg {Error sending message}
  1026. sleep 2
  1027. forward MSGEND
  1028.  
  1029. :MSGOK
  1030. boxmsg {Message from \m(_username): \m(_subject)}
  1031.  
  1032. :MSGEND
  1033. asg \%C \m(_csave)
  1034. undef _csave
  1035. undef _inmail
  1036. goto main
  1037.  
  1038. :LBL_11 ; CHANGE PASSWORD
  1039. clr
  1040. asg \%M 2
  1041. ;
  1042. ; Lock the database.
  1043. ;
  1044. hostlog {User \m(_username) changing password...}
  1045. LOCK
  1046. if failure error {Busy - try again later}
  1047. open read \fdef(_userfile)
  1048. if failure error {Error - try again later}
  1049. undef _myrecord
  1050. asg \&u[0] 0
  1051. ;
  1052. ; Read in the entire database because the whole thing must be written
  1053. ; out again when done.  The user's record number is assigned to _myrecord.
  1054. ;
  1055. for \%i 1 \m(_maxusers) 1 {
  1056.   read \&u[\%i]
  1057.   if failure break
  1058.   increment \&u[0]
  1059.   getfields {\&u[\%i]}
  1060.   if eq "\m(U_ID)" "\m(_username)" asg _myrecord \%i
  1061. }
  1062. close read
  1063. if not def _myrecord error {Lookup failure}
  1064. getfields {\&u[\m(_myrecord)]}
  1065.  
  1066. :GETPW
  1067. intext 2 {Old Password:    } 31 \m(_inactivity) *
  1068. if not def \%n goto GETPW
  1069. if not eq "\m(U_PW)" "\f.oox(\%n)" {
  1070.   unlock
  1071.   incr \%M
  1072.   error {Sorry.}
  1073. }
  1074. intext 3 {New Password:    } 31 \m(_inactivity) *
  1075. if failure goto main
  1076. if not def \%n goto GETPW
  1077. asg \%9 \%n
  1078. intext 4 {Retype Password: } 31 \m(_inactivity) *
  1079. if failure goto main
  1080. if eq "\%n" "\%9" forward NEWPWOK
  1081. asg \%M 5
  1082. msg {Passwords do not match - please try again}
  1083. incr \%M
  1084. msg {or use Ctrl-C to return to the main menu.}
  1085. sleep 2
  1086. clr
  1087. goto GETPW
  1088.  
  1089. :NEWPWOK
  1090. asg \&u[\m(_myrecord)] -
  1091. \m(U_ID)_\f.oox(\%n)_\m(U_PR)_\m(U_NM)_\m(U_AD)_\m(U_TP)_\m(U_EM)
  1092. saveuserdb
  1093. if success hostlog {Password changed} 
  1094. else error {FAILED - Password not changed}
  1095. sleep 2
  1096. goto main
  1097.  
  1098. :LBL_12 ; HELP
  1099. clr
  1100. if not exist \m(_helpfile) error {Sorry - no help available}
  1101. display \m(_helpfile)
  1102. goto main
  1103.  
  1104. :LBL_13 ; EXIT
  1105. clr
  1106. hostlog {Close transaction log}
  1107. close transact
  1108. def HOSTLOG echo \v(time) - \%1
  1109. hostlog {Exit host mode}
  1110. atp 2 2 Bye!
  1111. cur 3 1
  1112. cd \m(_startdir)
  1113. hangup
  1114. ;close connection
  1115. end 0
  1116.  
  1117. :LBL_14 ; DOS command
  1118. clr
  1119. if not > \m(_mypriv) 1 error {Sorry - insufficient privilege}
  1120. atp  2 \%C {EXECUTE A DOS COMMAND}
  1121. atp  4 \%C {Current directory: \freplace(\v(dir),\\,/)}
  1122. atp  6 \%C {CAUTION: Do NOT issue a command that:}
  1123. atp  8 \%C { 1. Might possibly require input from the PC keyboard.}
  1124. atp  9 \%C { 2. Starts a GUI program.}
  1125. atp 10 \%C { 3. Requires any type of interaction at all.}
  1126. atp 12 \%C {If you do, your session will become stuck and you will}
  1127. atp 13 \%C {have to hang up.  Only give commands that print textual}
  1128. atp 14 \%C {information on a DOS screen and then exit immediately.}
  1129. atp 15 \%C {The output will be displayed on your screen unless you}
  1130. atp 16 \%C {redirect it to a file, in which case you can download or}
  1131. atp 17 \%C {type the file afterwards from the main menu.}
  1132. while true {
  1133.   intext 19 {DOS Command: } 31
  1134.   if failure goto main
  1135.   if def \%n break
  1136. }
  1137. hostlog {DOS command "\fcontents(\%n)"}
  1138. if > \findex(>,\%n) 0 forward DOSREDIR
  1139. ;
  1140. ; Command is not redirected so we redirect it to a temp file
  1141. ; and then display the temp file.  Pipes don't work in Windows 95.
  1142. ;
  1143. asg _tmpfile \m(_tmpdir)K_\v(ntime).TMP
  1144. run \fcontents(\%n) > \freplace(\m(_tmpfile),/,\\)
  1145. ; asg _status \v(status)                ; Doesn't work
  1146. asg _status 2                ; Status is unknown
  1147. if exist \m(_tmpfile) {
  1148.   display \m(_tmpfile)
  1149.   delete \m(_tmpfile)
  1150. }
  1151. goto main
  1152.  
  1153. :DOSREDIR ; Command is already redirected, just run it.
  1154. run \fcontents(\%n)
  1155. asg _status 2
  1156. goto main
  1157.  
  1158. :BADEND
  1159. end 1
  1160.  
  1161. ; End of HOST.KSC
  1162.