home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / bbs102e.zip / bbsup.cmd < prev    next >
OS/2 REXX Batch file  |  1997-11-16  |  30KB  |  909 lines
  1. /*  BBS add-on for the SRE-http http server: version 1.02
  2.     This is the UPLOAD component. See BBS.CMD for download,
  3.     and BBSNEWU.CMD for new user registration.
  4.  
  5.                  **** IMPORTANT INSTALLATION NOTE ***
  6.  
  7. 1) A BBS.INI file MUST exist in the same directory BBSUP.CMD is installed
  8.    to.
  9.  
  10.                 --- END OF INSTALLATION NOTE --------
  11.  
  12. --------------------------------------------
  13.        User Configurable Parameters:
  14. ******************************************/
  15.  
  16. authorization_mode=0  /* if  =1, check authorization field for username/password,
  17.                          and use SRE-http privileges. If 0, use users.in files
  18.                           THIS SHOULD AGREE WITH THE VALUE IN BBS.CMD*/
  19.  
  20.  
  21.  
  22.  
  23. /*     ------------ End of User-Configurable Paramters =======*/
  24.  
  25.  
  26. /* get the list of values sent from SRE-http */
  27. parse arg  ddir, tempfile, reqstrg,list0,verb ,uri,user, ,
  28.           basedir ,workdir,privset,enmadd,transaction,verbose, ,
  29.          servername,host_nickname,homedir 
  30.  
  31. if verb="" then do
  32.    say " This is an add-on for the SRE-http web server. "
  33.    say " It is NOT meant be run from the command line! "
  34.    exit
  35. end  /* Do */
  36.  
  37. /*
  38. wow=charout('g:\goserv\dump.me',list0,1)
  39. say " wrote " length(list0) */
  40.  
  41. basedir=strip(basedir,'t','\')||'\'
  42.  
  43. upload_quick_check=1   /* if 1, the filename= component is check for preexting file */
  44.  
  45.  
  46. inifile=basedir||'bbs.ini'
  47.  
  48.  
  49. isit=fileread(inifile,inilines,,'E')
  50.  
  51. if isit<0 then do
  52.      say " ERROR: no BBS initialization file "
  53.      foo=responsebbs('forbid','BBS is unavailable')
  54.      return foo||' Error in BBS parameters file '
  55. end  /* Do */
  56.  
  57. signal on syntax name bad1 
  58. signal on error name bad1 
  59. mm=0
  60.  
  61. gobot:
  62. mm=mm+1
  63. if mm > inilines.0 then signal good1
  64. aline=inilines.mm
  65. interpret aline
  66. signal gobot
  67.  
  68. bad1:
  69. signal off error ; signal off syntax ;
  70. say " ERROR: error in BBS initialization file: " aline
  71. foo=responsebbs('forbid','error in BBS initialization file')
  72. return foo||' Error in BBS parameters file '
  73.  
  74. /* bbs_ini okay, or skipped.  Check, etc. various values, directories */
  75. good1:
  76.  
  77. signal off error ; signal off syntax ;
  78. bbs_param=translate(bbs_param_dir,'\','/')
  79. if abbrev(strip(bbs_param,'l','\'),'\') =0 & pos(':',bbs_param)=0 then /* must be relative dir*/
  80.    bbsdir=basedir||strip(bbs_param,'t','\')||'\'
  81. else
  82.   bbsdir=strip(bbs_param,'t','\')'\'
  83.  
  84.  
  85. if dosisdir(strip(bbsdir,'t','\'))=0 then do
  86.      say " ERROR: no BBS parameters directory "
  87.      foo=responsebbs('forbid','BBS is unavailable')
  88.      return foo||' BBS unavailable '
  89. end
  90.  
  91. incoming_dir=translate(incoming_dir,'\','/')
  92. if abbrev(strip(incoming_dir,'l','\'),'\')=0 & pos(':',incoming_dir)=0 then /* must be relative dir*/
  93.    incoming_dir=bbsdir||strip(incoming_dir,'t','\')||'\'
  94. else
  95.   incoming_dir=strip(incoming_dir,'t','\')'\'
  96.  
  97. if dosisdir(strip(incoming_dir,'t','\'))=0 then do
  98.      say " ERROR: no BBS incoming directory "
  99.      foo=responsebbs('forbid','BBS is unavailable')
  100.      return foo||' BBS unavailable '
  101. end
  102.  
  103. userlog_dir=translate(userlog_dir,'\','/')
  104. if abbrev(strip(userlog_dir,'l','\'),'\')=0 & pos(':',userlog_dir)=0 then /* must be relative dir*/
  105.    userlog_dir=bbsdir||strip(userlog_dir,'t','\')||'\'
  106. else
  107.    userlog_dir=strip(userlog_dir,'t','\')'\'
  108.  
  109. if dosisdir(strip(userlog_dir,'t','\'))=0 then do
  110.      say " ERROR: no BBS user log directory "
  111.      foo=responsebbs('forbid','BBS is unavailable')
  112.      return foo||' BBS unavailable '
  113. end
  114.  
  115.  
  116. if symbol('admin_email')<>'VAR' | symbol('bbs_smtp_gateway')<>'VAR' then do
  117.    send_alert=0
  118. end
  119. else do
  120.    if admin_email=0 | bbs_smtp_gateway=0 then send_alert=0
  121.    if admin_email='' | bbs_smtp_gateway='' then send_alert=0
  122. end  /* Do */
  123.  
  124.  
  125. fixexpire=value(enmadd||'FIX_EXPIRE',,'os2environment')
  126.  
  127. /* a time  date stamp */
  128.  d1=date('b')
  129.  t1=time('m')/(24*60)
  130.  nowtime=d1+t1
  131.  
  132.  user='USER' ; pwd='PWD'
  133.  
  134. /* check on upload log */
  135.   upload_log=bbsdir||'UPLOAD.LOG'
  136.   if stream(upload_log,'c','query exists')=" " then do  /* doesn't exist, create it */
  137.        call lineout upload_log,'; BBS upload log file '
  138.        call lineout upload_log
  139.   end
  140.  
  141.  
  142. /*in "authorization mode" 
  143.     BBS REQUIRES that a USERNAME/password be available (except for superusers)
  144.    otherwise, username/pwd is pulled from request (string or body) */
  145.  
  146. if authorization_mode=1 then do
  147.   goo=reqfield('AUTHORIZATION:')
  148.   if goo=' '  then do
  149.       foo=responsebbs('unauth','BBS_Authorization','Username and password required to access this BBS ')
  150.       return foo||' BBS: No user name given '
  151.   end
  152. end
  153.  
  154. /*is this an upload? Determine by checking for a multipart/form-data  header. */
  155.  
  156. conttype=reqfield('content-type')
  157. if POS("MULTIPART/FORM-DATA",upper(contTYPE))>0 THEN DO
  158.    call BBS_upload    /* USES LOTS OF globals */
  159.    if upload_stat='-1' then return 'BBS file: username required '
  160.    parse var upload_stat foil foilen
  161. /* note in users transaction log */
  162.    if foil<>0 then do
  163.       foo=add_userinfo(foilen,aweight,tryname)
  164.       RETURN 'BBS file uploaded '
  165.    end
  166.    else do
  167.        RETURN 'BBS file upload failure '
  168.    end  /* Do */
  169. end  /* Do */
  170.  
  171.   
  172. /* if here, not file upload syntax. Perhaps check file? */
  173.  
  174. checkfile1=0 ; checkfile2=0; theuser=0 ; thepwd=0
  175. do until list0=""
  176.     parse var list0 a1 '&' list0
  177.     parse var a1 b1 '=' b2
  178.     b2=packur(translate(b2,' ','+'))
  179.     if strip(upper(b1))='CHECKFILE1' then checkfile1=strip(upper(b2))
  180.     if strip(upper(b1))='CHECKFILE2' then checkfile2=strip(upper(b2))
  181.     if strip(upper(b1))="USER" then theuser=strip(upper(b2))
  182.     if strip(upper(b1))="PWD" then thepwd=strip(upper(b2))
  183. end
  184. if checkfile1=0 & checkfile2=0 then do
  185.      foo=responsebbs('badreq','Bad File upload syntax',' Bad file upload syntax ')
  186.      return foo||' Unknown BBS command '
  187. end  /* Do */
  188.  
  189. upload_dir=strip(incoming_dir,'t','\')||'\'
  190.  
  191. /* gonna need his user.in file */
  192. if authorization_mode<>1 then do     
  193.   if check_user(theuser,thepwd)=0 then do     /* (user_header. , userlog_lines, */
  194.        upload_stat='-1'  /*check_user exit with a 'FILE '*/
  195.        return 0
  196.   end
  197. end
  198. /* is there a "personal upload directory" listed */
  199.  
  200. aa1=fig_upload_dir(upload_dir,checkfile1,checkfile2)  /* expose user_header */
  201. parse var aa1 upload_dir .
  202. aa1=strip(aa1)
  203.  
  204. tr=strip(translate(checkfile2,'\','/'))
  205. if right(tr,1)='\' then do
  206.    checkfile1=translate(checkfile1,'\','/')
  207.    checkfile2=tr||strip(checkfile1,'l','\')
  208. end
  209.  
  210. if checkfile2=' ' | checkfile2=0   then do  /* use checkfile1 -- the own name */
  211.    checkfile=translate(checkfile1,' ','\/')
  212.    look1=word(checkfile,words(checkfile))
  213. end  /* Do */
  214. else do
  215.     look1=checkfile2
  216. end  /* Do */
  217.  
  218. call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  219.  
  220. look2=make_afile(upload_dir,look1)
  221.  
  222. lookd=filespec('d',look2)||filespec('p',look2)
  223.  
  224. /* first check for directory */
  225. if dosisdir(strip(lookd,'t','\'))=0 then do
  226.   if verbose>2  then say " BBSUP file check: No such directory = " lookd
  227.   call lineout tempfile, "<html><head><title>UPLOAD File Check: Bad Directory</title></head>"
  228.   call lineout tempfile, "<body><h2>The sub-directory you selected does exist</h2>"
  229.   call lineout tempfile,' The sub directory you selected, <b> 'look1 ',</b> does not exist.'
  230.   call lineout tempfile, "</body></html>"
  231.   call lineout tempfile  /* close */
  232.   'FILE ERASE TYPE text/html NAME' tempfile
  233.   return "BBS check for upload file existence "
  234. end
  235.  
  236. if stream(look2,'c','query exists')<>' ' then do  /* does exist */
  237.   if verbose>2  then say " BBSUP file check: File Exists = " look2
  238.   call lineout tempfile, "<html><head><title>UPLOAD File Check: Found</title></head>"
  239.   call lineout tempfile, "<body><h2>The file you selected does exist</h2>"
  240.   call lineout tempfile,' The file you selected, <b> 'look1 ',</b> already '
  241.   call lineout tempfile,' exists in the incoming directory '.
  242.   call lineout tempfile, "</body></html>"
  243.   call lineout tempfile  /* close */
  244.   'FILE ERASE TYPE text/html NAME' tempfile
  245. end  /* Do */
  246. else do
  247.   if verbose>2  then say " BBSUP file check: File Does NOT Exist = " look2
  248.   call lineout tempfile, "<html><head><title>UPLOAD File Check: Not Found</title></head>"
  249.   call lineout tempfile, "<body><h2>The file you selected does not exist</h2>"
  250.   call lineout tempfile,' The file you selected, <b> 'look1 ',</b> does <b>not</b> '
  251.   call lineout tempfile,' exist in the incoming directory '.
  252.   call lineout tempfile, "</body></html>"
  253.   call lineout tempfile  /* close */
  254.   'FILE ERASE TYPE text/html NAME' tempfile
  255. end
  256. return "BBS check for upload file existence "
  257.  
  258.  
  259. /******************************************************************/
  260. /* this is called ONLY if the content-type request header contains
  261.    "multipart/form-data". We do NOT check
  262.     here for that condition (we assume that the caller has checked)  */
  263.  
  264. bbs_upload:
  265.  
  266. /* procedure expose incoming_dir upload_minfree upload_maxsize  ,
  267.    upload_log user verbose  enmadd transaction host_nickname homedir  list0  ,
  268.    verbose userlog_lines. user_header. */
  269.   
  270.  
  271. atype=conttype
  272. crlf='0d0a'x
  273. upload_dir=strip(incoming_dir,'t','\')||'\'
  274.  
  275. theuser=user ; thepwd=' '
  276. nwritten=0
  277.  
  278. /* 1)look for content type request header */
  279. atype2=reqfield('content-length')
  280.  
  281. /*atype="multipart/form-data; boundary=---------------------------309151678928465"*/
  282.  
  283. rept=""
  284.  
  285. parse var atype thetype ";" boog 'boundary=' abound    /* get the boundary */
  286.  
  287. if abound="" then do
  288.    upload_stat=bbsupload_status( "0 , No boundary ")
  289.    return
  290. end
  291.  
  292. /* check for space constraints -- WE ASSUME ONLY 1 FILE AT A TIME!   */
  293. adri=filespec('D',upload_dir)
  294. tmp1=sysdriveinfo(adri)
  295. spacefree=word(tmp1,2)
  296. lenblock=length(list0)
  297. if lenblock> (upload_maxsize*1000) then do /*asssume bulk of body is the file */
  298.           upload_stat= bbsupload_status("0, File exceeds maximum allowable size of"||upload_maxsize)
  299.           return 0
  300. end
  301. if lenblock> (spacefree-(1000*upload_minfree)) then do
  302.          upload_stat=bbsupload_status("0, Not enough disk space available. ")
  303.          return 0
  304. end
  305.  
  306. /* if here, enough room! */
  307. abound="--"||abound   /* since boundaries always start with -- */
  308.  
  309. abd2=abound||crlf
  310.  
  311. /* loop through message, pulling out blocks and storing in stem var bigstuff. */
  312.  
  313. /* we have parsed the blocks..
  314.   There are 3 types of header info (in ablock.var.i.j)
  315.        Content-Type: mime type; if missing assume text/plain
  316.        name: the variable name (standard form stuff)
  317.       filename: name of local file (added by browser, on type=file elements)
  318.                 This is used as default file name, if need be.
  319. Not retained:       Content-Disposition:  should be form-data
  320. */
  321. /*abody=list0*/
  322.  
  323. parse var list0 foo1 (abd2) list0    /* move beyond first boundary and it's crlf */
  324. /* check for netscape 2.0 incorrect format */
  325. if pos(abound,list0)=0 then do   /* no ending boundary, so add one */
  326.    list0=list0||crlf||abound||" -- "
  327. end
  328.  
  329. mm=0
  330. do until list0=""
  331.   parse var list0 thestuff (abound) list0        /* get a  boundary defined block */
  332.  
  333.   if strip(left(thestuff,4))="--" then leave        /* -- signals no more */
  334.   if list0="" then leave
  335.   mm=mm+1
  336.   ablock.varname.mm=0 ; ablock.filename.mm=0
  337.   ablock.ct.mm=0
  338.   do forever            /* get block headers.  Stop when hit a blank line */
  339.      parse var thestuff anarg (crlf) thestuff
  340.  
  341.      if anarg="" then do
  342.            leave
  343.      end
  344.      else do                    /* extract the arguments on this line */
  345.          do until anarg=""
  346.               parse var anarg anarg1 ";" anarg
  347.               boob1=pos(':',anarg1) ; boob2=pos('=',anarg1)
  348.               if boob1=0 then nixon=boob2
  349.               if boob2=0 then nixon=boob1
  350.               if boob1>0 & boob2>0 then nixon=min(boob1,boob2)
  351.               t1=translate(strip(strip(substr(anarg1,1,nixon-1)),,'"'))
  352.               t2=strip(strip(substr(anarg1,nixon+1)),,'"')
  353.               if t1="NAME" then ablock.varname.mm=t2
  354.  
  355. /* do quick check? */
  356.               if t1="FILENAME" then do
  357.                   if upload_quick_check=1 & user_header.!uploads=0 then do
  358.                       oo0=translate(t2,' ','/\')
  359.                       oo1=strip(word(oo0,words(oo0)))
  360.                       oo2=stream(upload_dir||oo1,'c','query exists')
  361.                       if oo2<>' ' then do
  362.                           upload_stat=bbsupload_status("0, Can not upload, file already exists: "||oo1)
  363.                           return 1
  364.                       end
  365.                   end  /* upload_quick_check */
  366.                   ablock.filename.mm=t2
  367.               end               /* filename */
  368.               if t1="CONTENT-TYPE" then ablock.ct.mm=t2
  369. /* don't bother storing content-disposition */
  370.           end     /* exract arguments */
  371.      end        /* extract args on this line */
  372.   end                    /* get a line */
  373.   if thestuff<>"" then do
  374.     ablock.body.mm=left(thestuff,length(thestuff)-2)  /* strip off ending crlf */
  375.     parse var list0 foo (crlf) list0
  376.   end
  377.   else do
  378.      ablock.body.mm=""
  379.   end
  380. end
  381.  
  382. nblocks=mm
  383.  
  384. if nblocks=0 then do
  385.       upload_stat= bbsupload_status( " 0 , ERROR: No data recieved. ")
  386.       return 0
  387. end
  388.  
  389.  
  390. /* look for USER and PWD ablock.name.n elements */
  391. if authorization_mode<>1 then do
  392.   do arf=1 to nblocks
  393.    if upper(ablock.varname.arf)='PWD' then thepwd=upper(strip(ablock.body.arf))
  394.    if upper(ablock.varname.arf)='USER' then theuser=upper(strip(ablock.body.arf))
  395.   end /* do */
  396.  
  397. /* (user_header. , userlog_lines, */
  398.  
  399.  
  400.   if check_user(theuser,thepwd)=0 then do
  401.       upload_stat='-1'  /*check_user exit with a 'FILE '*/
  402.        return 0
  403.   end
  404. end
  405.  
  406.  
  407. if verbose>2 then say " Upload of " lenblock " from " theuser ' : ' thepwd
  408.  
  409. /* prepare a "report" on this upload */
  410. rept="      ====================== ====================="||crlf
  411. rept=rept||date()|| " " ||time()|| " :: Upload from " || theuser||crlf
  412.  
  413.  
  414. /* look for non 0 .filename. */
  415. def_upload=upload_dir
  416. do jj=1 to nblocks
  417.    if ablock.body.jj="" then iterate /* empty block */
  418.    if ablock.filename.jj<>0     then do   /* got a file block */
  419.       if symbol('ablock.filename.'||jj)<>'VAR' then
  420.           origfile='UNKNOWN'
  421.       else
  422.            origfile=ablock.filename.jj
  423.       amatch=jj
  424.       namekey=ablock.varname.jj
  425.       tryname=" "
  426.       ctval=ablock.ct.jj
  427.       do ll=1 to nblocks
  428.           if ll=amatch then iterate         /* don't check self */
  429.           if ablock.varname.ll=namekey then do    /* this is the naming bar */
  430.                 tryname=ablock.body.ll
  431.                 ablock.varname.ll=0     /* don't need anymore */
  432.                 ablock.varname.amatch=0
  433.                 leave
  434.           end
  435.       end        /* scan for match */
  436.  
  437.   tryname=translate(tryname,'\','/')
  438.  
  439. /* determine the directory */
  440.  
  441.    if filespec('n',tryname)=" " then do
  442.         tryname0=filespec('n',origfile)
  443.  
  444.         if tryname=' ' then
  445.              tryname=tryname0
  446.         else
  447.              tryname=strip(tryname,,'\')||'\'||strip(tryname0,,'\')
  448.    end
  449.    if tryname=" " then          /* use a default name */
  450.         tryname='FILE????.UPL'
  451.  
  452.    /* is there a "personal upload directory" listed */
  453.    aa1=fig_upload_dir(def_upload,tryname,tryname)  /* expose user_header */
  454.    parse var aa1 pupdir aweight 
  455.    
  456.    usefile=make_afile(pupdir,tryname)
  457.  
  458.    chkf=strip(filespec('d',usefile)||filespec('p',usefile),'t','\')
  459.    if dosisdir(chkf)=0 then do
  460.       a=lastpos('\',translate(tryname,'\','/'))
  461.       if a>1 then
  462.          tt=delstr(tryname,a+1)
  463.       else
  464.           tt=tryname
  465.       upload_stat=bbsupload_status("0, Upload directory does not exist: "||tt)
  466.       return 1
  467.    end
  468.  
  469. /* if ? in file, then try making a temporary file */
  470.    if pos('?',usefile)>0 then do
  471.           usefile=bbsmake_temp_F(usefile)
  472.    end
  473.  
  474. /* error if it exists */
  475.     foo=stream(usefile,'c','query exists')
  476.     if foo<>"" then do
  477.        if VERBOSE>0 then say " Can not overwrite " usefile
  478.        upload_stat= bbsupload_status(" 0 , Can not overwrite  pre-existing file: "||tryname)
  479.        return 0
  480.     end
  481.  
  482. /* will it fit? */
  483.      clen=length(ablock.body.amatch)
  484.      if clen> (upload_maxsize*1000) then do
  485.           upload_stat= bbsupload_status("0, File exceeds maximum allowable size of "||upload_maxsize)
  486.           return 0
  487.      end
  488.      adri=filespec('D',usefile)
  489.      tmp1=sysdriveinfo(adri)
  490.      spacefree=word(tmp1,2)
  491.      if clen> (spacefree-(1000*upload_minfree)) then do
  492.          down_okay=0
  493.          upload_stat=bbsupload_status("0, Not enough disk space available on our server. ")
  494.          return 0
  495.      end
  496.  
  497. /* it fits! */
  498.       nwritten=nwritten+1
  499.       foo=charout(usefile,ablock.body.amatch,1)  /* write her out! */
  500.       if foo<>0 then do
  501.            upload_stat=bbsupload_status(" 0 , Error occured while writing file: "|| tryname)
  502.       end
  503. /* else, write stuff to upload_log */
  504.       if VERBOSE>2 then say " BBS upload: " usefile
  505.       dalen=length(ablock.body.amatch)
  506.       rept=rept||dalen||" bytes to  " || usefile||crlf
  507.       rept=rept||"Client-side name="||origfile||crlf
  508.       if ctval<>0 then rept=rept||" Content-Type: "|| ctval||crlf
  509.        foo=bbswrite_uplog(upload_log,rept)
  510.    end   /* got a filename block */
  511. end                     /* look for a filename block */
  512.  
  513. /* write generic comments */
  514. rept= ""
  515. do mm=1 to nblocks      /* look for misc comments */
  516.   if ablock.varname.mm<>0 & ablock.filename.mm=0 then do
  517.        if wordpos(upper(ablock.varname.mm),'USER PWD')>0 then iterate
  518.        rept=rept||ablock.varname.mm ||" =  "|| ablock.body.mm||crlf
  519.   end
  520. end
  521. if rept<>"" then do
  522.   foo=bbswrite_uplog(upload_log,rept)
  523. end
  524.  
  525. if nwritten>0 then do
  526.    yip=bbsupload_status(" 1  , Upload completed as:  "||tryname,tryname)
  527.    upload_stat=yip' 'dalen
  528.  
  529. /* send email alert? */
  530.     if send_alert=1 then  foo=mail_alert(theuser,yip,dalen)
  531.  
  532.     return 0
  533. end
  534.  
  535. upload_stat=bbsupload_status(" 0  ,  Your request did not include a file to upload. ")
  536. return 0
  537.  
  538.  
  539. /***********************************************************/
  540. /* Write record to upload log */
  541. /********************************************************/
  542. bbswrite_uplog: procedure expose verbose
  543. parse arg uplog,rept
  544. AFOO=sref_open_read(UPLOG,20,'WRITE')
  545. IF AFOO<0 THEN do
  546.   audit ' could not write upload record '
  547.   foo=stream(uplog,'c','close')
  548. end
  549. else do
  550.   foo=charout(uplog,rept)
  551.   foo=stream(uplog,'c','close')
  552. end
  553.  
  554. return 0
  555.  
  556.  
  557. /******************************************************/
  558. /* Used by put_file     */
  559. /******************************************************/
  560. bbsupload_status:procedure expose verbose
  561. parse arg ok "," amess,afile
  562. foo=sref_expire_response(1000)
  563. if ok=0 then do
  564.     doc = '<!doctype html public "-//IETF//DTD HTML 2.0//EN"> <html><head><title>'
  565.     doc=doc||" Unsuccessful upload to BBS </title></head><body> "
  566.     doc=doc||" <h3> Unsuccessful upload to BBS </h3> "
  567.     doc=doc||" Sorry, the file could not be uploaded.  <p> <b> Error: </b>"||amess
  568.     doc=doc||"</body></html>"
  569.     'var type text/html name doc '  /* tell goserve to send status message */
  570.     return 0
  571. end
  572. else do
  573.     doc = '<!doctype html public "-//IETF//DTD HTML 2.0//EN"> <html><head><title>'
  574.     doc=doc||" Successful upload to BBS </title></head><body> "
  575.     doc=doc||" <h3> Successful upload to BBS </h3> "
  576.     doc=doc||" Your uploded file was succesfully recieved, and saved as:<b>"|| afile ||' </b>'
  577.     doc=doc||"</body></html>"
  578.     'var type text/html name doc '  /* tell goserve to send status message */
  579.     return 1
  580. end  /* Do */
  581.  
  582.  
  583.  
  584. /******************************************/
  585. /* dostempname, with excess ? check */
  586. /****************************************/
  587. bbsmake_temp_F: procedure expose verbose
  588. parse arg usefile
  589.  if usefile="" | usefile=0 then usefile="DOWN????.UPL"
  590.           nqs=0
  591.           do mm=1 to length(usefile)   /* Rexx bombs with > 5 ?s */
  592.                if substr(usefile,mm,1)="?" then do
  593.                    nqs=nqs+1
  594.                    if nqs>5 then
  595.                       usefile=overlay('_',usefile,mm)
  596.                 end
  597.            end
  598.    return dostempname(usefile)
  599.  
  600. /* -----------------------------------------------------------------------*/
  601.  
  602.  
  603. /* ------------------------------- */
  604. /* check for username/password. 
  605. IF none, or incorrect, (username=USER or username=" "),
  606. the issue an "incorrect username/password" response .
  607.  
  608. Note the use of .in files to store information "by user", rather then
  609. central registry 
  610.  
  611. */
  612.  
  613. check_user:procedure expose userlog_dir userlog_lines.  ,
  614.         servername serverport tempfile verbose  user_header. ,
  615.         userfile verbose 
  616.  
  617. parse arg auser,apwd
  618.  
  619.  
  620. if upper(auser)="USER" then do
  621.   mess2='You did not specify a username and password'
  622.   signal nonesuch
  623. end
  624.  
  625. /* check for .in file */
  626. userfile=userlog_dir||auser||'.in'
  627. if verbose>2 then say " looking for bbs-user file: " userfile
  628. shtread=0
  629.  
  630. newread:
  631. if shtread=0 then do
  632.    ww=fileread(userfile,userlog_lines,40,'E')   /*assume header within 40 lines*/
  633.    shtread=1
  634. end
  635. else do
  636.    ww=fileread(userfile,userlog_lines,,'E')
  637. end
  638. mess2='Access denied.  '
  639.  
  640. if userlog_lines.0>500 & verbose>1 then 
  641.  say "BBS Warning: the user-log for " auser " is getting large. "
  642.  
  643. /* if no user file, tell the client */
  644. if userlog_lines.0=0 then do
  645.      mess2= " No such user:" auser
  646.      if verbose>2 then say  mess2
  647.      signal nonesuch
  648. end
  649.  
  650. /* if here, got userlog lines-- either from file, or just created
  651.  So extract headers from userlog_lines. */
  652.  
  653.  daheaders=get_user_header(userfile)
  654.  if wordpos('MESSAGES',daheaders)=0 and shtread=1 then do /* gotta read all of file*/
  655.      signal newread
  656.  end
  657.  
  658. /* check username password */
  659.  
  660.  if wordpos('USER',daheaders)=0 then do  /* no user/pwd info */
  661.       mess2=" Missing username/password info for:" auser
  662.      if verbose>2 then say  mess2
  663.      signal nonesuch
  664.  end  /* Do */
  665.  else do
  666.     parse upper var user_header.!user  buser bpwd
  667.     if strip(auser)<>strip(buser) | strip(apwd)<>strip(bpwd) then  do
  668.          mess2=" Password mismatch for:" auser
  669.         if verbose>2 then say  mess2
  670.         signal nonesuch
  671.     end  /* pwd and user match */
  672.  end
  673.  
  674. return 1                /* 1 signals success */
  675.  
  676.  
  677. nonesuch:  /* jump here to  issue an error message */
  678.  
  679.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  680.   call lineout tempfile, "<html><head><title>BBS: Upload Error </title></head>"
  681.   call lineout tempfile, "<body><h2>Problem with BBS Upload</h2>"
  682.   call lineout tempfile,' Sorry, there was a problem processing your file upload.'
  683.   call lineout tempfile,' <br> <B>Problem description:</b><em>'mess2'</em>'
  684.   call lineout tempfile, "</body></html>"
  685.   call lineout tempfile  /* close */
  686.  
  687.  'FILE ERASE TYPE text/html NAME' tempfile
  688.  if verbose>2 then say " BBS Upload error: " mess2
  689.  
  690.  return 0
  691.  
  692.  
  693. /*************/
  694. /* extract user header from userlog_lines. */
  695. get_user_header:procedure expose userlog_lines. user_header.
  696.  
  697. /* get header info. ; lines are ignored. User_header.0 contains list of
  698.    .extensions found (i.e.; user_header.!status, user_header.!privileges
  699.    yield user_header.0='STATUS PRIVILEGES '
  700. */
  701. user_header.0=' '; nups=0
  702. do mm=1 to userlog_lines.0
  703.      aline=strip(userlog_lines.mm)
  704.      if abbrev(aline,';')=1 | aline=' ' then iterate
  705.      parse var aline atype ':' aval ; uatype=upper(strip(atype))
  706.      user_header.0=user_header.0||' '||uatype
  707.      if uatype='MESSAGES' then leave
  708.      if uatype="UPLOAD_DIR" then do
  709.           nups=nups+1
  710.           parse upper var aval user_header.!upload_prefix.nups ,
  711.                                user_Header.!upload_dir.nups ,
  712.                                user_header.!upload_weight.nups .
  713.      end /* do */
  714.      else do
  715.         fo='!'||uatype
  716.         user_header.fo=aval
  717.         if uatype='STATUS' then userlog_lines.statusat=mm
  718.      end
  719.  end /* do */
  720.  user_header.!uploads=nups
  721.  
  722.  return user_header.0
  723.  
  724.  
  725.  
  726.  
  727. /********************************************/
  728. responsebbs:procedure
  729.  parse arg  request,text,stuff
  730.  
  731.  
  732.   select
  733.     when request='badreq'   then use='400 Bad request syntax'
  734.     when request='notfound' then use='404 Not found'
  735.     when request='forbid'   then use='403 Forbidden'
  736.     when request='unauth'   then use='401 Unauthorized'
  737.     when request='notallowed' then use='405 Method not allowed'
  738.     when request='notimplemented' then use='501 Not implemented'
  739.     otherwise do
  740.         use='406 Not acceptable'
  741.         call pmprintf('weird response '|| request||' '|| message)
  742.       end
  743.     end  /* Add others to this list as needed */
  744.  
  745.  
  746.   /* Now set the response and build the response file */
  747.   'RESPONSE HTTP/1.0' use     /* Set HTTP response line */
  748.   parse var use code text
  749.   if request='notallowed' then do
  750.      'HEADER ADD Allow:HEAD '
  751.   end
  752.  
  753.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  754.   call lineout tempfile, "<html><head><title>"text"</title></head>"
  755.   call lineout tempfile, "<body><h2>Sorry...</h2>"
  756.   select
  757.     when request='unauth' then do
  758.         'header add WWW-Authenticate: Basic Realm=<'text'>'  /* challenge */
  759.        if stuff=' ' then
  760.          call lineout tempfile,' You are not authorized to visit this area of the bulletin board '
  761.        else
  762.          call lineout tempfile,' You must supply a Username if you wish to use this BBS '
  763.     end
  764.     when request='notfound' then
  765.       call lineout tempfile,' File is unavailable: ' stuff
  766.     when requeset='forbid' then
  767.       call lineout tempfile,' BBS is unavailable.'
  768.     otherwise
  769.        call lineout tempfile,' Request denied: ' stuff
  770.   end
  771.   call lineout tempfile, "</body></html>"
  772.   call lineout tempfile  /* close */
  773.  
  774.   iia=dosdir(tempfile,'s')
  775.   'FILE ERASE TYPE text/html NAME' tempfile
  776.  
  777.  
  778.  
  779.   return word(use,1)||' '||iia
  780.  
  781.  
  782. end  /* Do */
  783.  
  784. return ' '
  785.  
  786.  
  787.  
  788. /**********************/
  789. /* add info to user file */
  790.  
  791. add_userinfo:procedure expose user_header. userlog_lines. userfile ,
  792.             write_details counter_file nowtime 
  793.  
  794. parse arg thesize,aweight,ufile
  795.  
  796.  
  797. if wordpos('STATUS',user_header.0)=0 then 
  798.   infoat='0 0 0 0 0 '
  799. else
  800.   infoat=user_header.!status
  801.  
  802. parse var infoat dl ul dlb ulb .
  803. IF AWEIGHT=' ' then AWEIGHT=1
  804. ul=ul+aweight ; ulb=ulb+(aweight*thesize)
  805.  
  806. ii=userlog_lines.statusat
  807. userlog_lines.ii='Status: 'dl' 'ul' 'dlb' 'ulb' 'nowtime
  808.  
  809. if write_details=1 then do
  810.     vv=userlog_lines.0+1
  811.     userlog_lines.0=vv
  812.     isdir2=upper(strip(translate(isdir,'/','\'),,'/')||'/')
  813.     userlog_lines.vv='Upload ' thesize ' bytes to ' ufile ' '  time('n') date('n')
  814.     userlog_lines.0=vv
  815. end  /* Do */
  816.  
  817. /* save userlog file */
  818. aa=filewrite(userfile,userlog_lines)
  819. if aa=0 & verbose>0 then
  820.   call pmprintf( " Could not augment&update BBS userfile: " userfile)
  821.  
  822.  
  823. return ' '              
  824.  
  825.  
  826.  
  827. /* -------------------- */
  828. /* Mail an alert to the administrator */
  829. /* if here, a match occurred */
  830. mail_alert:procedure expose servername admin_email verbose bbs_smtp_gateway
  831. parse arg user,thefile,filelen
  832.  
  833.    adate=date('N') ;atime=time('N')
  834.    CRLF = '0d0a'x
  835.  
  836.  
  837.    asubject ='Subject: Notification of BBS Upload '
  838.  
  839.    themessage="Date: " || adate || ' ' ||atime
  840.    themessage=themessage||crlf||'From: WebServer@'||servername
  841.    themessage=themessage||crlf||asubject
  842.    themessage=themessage||crlf||'To: '||admin_email||crlf
  843.  
  844.    themessage=themessage||crlf||'A file has been uploaded to the BBS at '||servername
  845.    themessage=themessage||crlf||"    Date of occurrence: " || adate || ' ' ||atime
  846.    themessage=themessage||crlf||'            From user: '|| user
  847.    themessage=themessage||crlf||' Uploaded File saved to: '|| thefile
  848.    themessage=themessage||crlf||'            File length: '||filelen
  849.    themessage=themessage||crlf||crlf||'Optional message: '||themessage
  850.  
  851.    foo=sref_mailit(admin_email,themessage,bbs_smtp_gateway)
  852.    if verbose>2 then call pmprintf(" BBS alert E-mail status: "foo)
  853.  
  854.    return foo
  855.  
  856. /*******************************************/
  857. /* determine the upload directory */
  858. fig_upload_dir:procedure expose user_header.
  859. parse arg defup,origname,username
  860.  
  861. username=strip(strip(translate(username,'\','/'),'l','\'))
  862.  
  863. if user_header.!uploads=0 then do  /* just use defup */
  864.     return defup||' '||1.0
  865. end
  866. /* check upload_dirs. First, if username=0 or ' ', then JUST CHECK
  867.  DEFAULT "prefix" (we only use the "name" part of the "own file name" --
  868.  so no point in looking for any other prefix */
  869.  if username=0 | username=' ' then do
  870.      prefix=''
  871.  end
  872.  else do
  873.     im=pos('\',username)
  874.     if im=0 then
  875.          prefix=''
  876.     else
  877.          prefix=substr(username,1,im-1)
  878.  end /* do */
  879.  
  880.  prefix=upper(Prefix)
  881.  
  882. /* search for a matching prefix */
  883.  do iu=1 to user_header.!uploads
  884.     if user_header.!upload_prefix.iu=prefix then do /* note use of * as flag */
  885.            return '*'||user_header.!upload_dir.iu||' '||user_header.!upload_weight.iu
  886.     end /* do */
  887.     if user_header.!upload_prefix.iu='DEFAULT' then DO
  888.           defup=user_header.!upload_Dir.iu||' '||user_header.!upload_weight.iu
  889.     end /* do */
  890.  end /* do */
  891.  return defup||' '||1.0
  892.  
  893.  
  894. /***********************************/
  895. /* create a filename, check for * alias flag */
  896. make_afile:procedure
  897. parse arg pupdir,tryname
  898.  
  899. pupdir=strip(strip(translate(strip(pupdir),'\','/'),'t','\'))
  900. tryname=strip(translate(strip(tryname),'\','/'))
  901. if abbrev(pupdir,'*')=1 then do
  902.    pupdir=substr(pupdir,2)
  903.    im=pos('\',tryname) 
  904.    if im>0 then
  905.       tryname=substr(tryname,im+1)
  906. end /* do */
  907. usefile=strip(pupdir,'t','\')||'\'||strip(tryname,'l','\')
  908. return usefile
  909.