/*  */
virtcfg:

CHECKIT=0   /* Change this to 0 if you want to enable REMOTE configuration by SUPERUSERS */

/* background color */
USECOLOR='2dd52f'

/* ---------------- DO NOT MODIFY BELOW THIS LINE  ------------------ */

parse arg  ddir, tempfile, sel,list,verb ,uri,user, ,
          basedir ,workdir,privset,enmadd,transaction,verbose, ,
         servername,host_nickname,homedir,aparam,semqueue,prog_file,reqnum

/* parse arg ddir,tempfile,sel,list,verb,uri,user,basedir,workdir,privset,enmadd,transaction,verbose*/

if verb="" then do
   say " This SRE-http add-on is NOT meant to be run from the command line."
   say " It can be invoked by using CONFIGUR.HTM "
   exit
end  /* Do */


list=translate(list, ' ', '+'||'090a0d'x)  /* Whitespace, etc. */

crlf='0d0a'x
who2=extract('CLIENTADDR')
saddr2=extract('SERVERADDR')

NO_REM=VALUE('SREF_NO_REMOTE_CONFIG',,'OS2ENVIRONMENT')

select
   when checkit=1 | no_rem>0 then do

/* only if user = serveraddress !!! */
     if who2<>saddr2 | no_rem=2 then do

        call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
        call lineout tempfile, "<html><head><title>SRE-http remote configurator disabled </title>"
        call lineout tempfile, '</head><body  bgcolor="#'||usecolor||'">'

        call lineout tempfile,' <strong> Action not allowed remotely.</strong> <pre>'
        call lineout tempfile,' </body> </html> '
        call lineout tempfile
        foo=sref_gos('FILE ERASE TYPE text/html NAME' tempfile)
        return 'VIRTCFG: action not allowed remotely. '
     end
   end
   otherwise do
      if wordpos('SUPERUSER',privset)=0 then do
        'RESPONSE HTTP/1.1 401 Unauthorized '     /* Set HTTP response line */
         att=sref_gmt()
        'HEADER Noauto ADD Date: 'att

        'header add WWW-Authenticate: Basic Realm=<CONFIGURE>'  /* challenge */

        call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
        call lineout tempfile, "<html><head><title>Not authorized </title>"
        call lineout tempfile, '</head><body  bgcolor="#'||usecolor||'">'

        call lineout tempfile,' <strong> You do not have configuration rights.</strong> <pre>'
        if who2=saddr2 then 
                call lineout tempfile,'<br> <Em> You may want to edit VIRTCFG.CMD </em> '
        call lineout tempfile,' </body> </html> '
        call lineout tempfile
         iia=dosdir(tempfile,'s')

        'FILE ERASE TYPE text/html NAME' tempfile
        return '401 'iia ' VIRTCFG: not permitted to configure. '
      end
   end
end

list=strip(list)
select 
   when upper(list)='TODO=SHOW' | upper(list)='TODO=SHOW_HEADER' then
        signal doshow
   when upper(list)='TODO=SET' then
        signal doset

   when upper(list)='TODO=CURRENT' then
        signal showcurrent

   otherwise
        signal dochange
end  /* select */


/* jump here to show values */
doshow:

virtualfile=value(enmadd||'VIRTUAL_FILE',,'os2environment')
   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
   call lineout tempfile, "<html><head><title>SRE-http: Virtual Directories </title>"
   call lineout tempfile, '</head><body  bgcolor="#'||usecolor||'">'


aa=sref_fileread(virtualfile,'lins',,'E')

call lineout tempfile, "<h1> SRE-http:  Virtual Directories  </h1> <p>"

if upper(list)='TODO=SHOW' then
   call lineout tempfile, "<h2> List of "header" comments </h2> <pre> <blockquote>"
else
   call lineout tempfile, "<h2> Description of virtual directories </h2> <pre> <blockquote>"

/* show "header comments" */
iat=0
do until iat >= lins.0
   iat=iat+1
   if  abbrev(strip(lins.iat),';')  then do
        foo=strip(lins.iat) ;foo=strip(foo,'l',';')
         call lineout tempfile, foo 
   end  /* Do */
   else do
        leave
   end
end /* do -- iat is the first non header comment line  */
call lineout tempfile, '</blockquote></pre> '

/* view descriptive header only? */
if upper(list)='TODO=SHOW_HEADER' then do
   call lineout tempfile,' <hr> </body></html>'
   call lineout tempfile
   foo=sref_gos('file erase  type text/html name  ' tempfile)
   return ' done '
end  /* Do */



/* read in usernames, etc */
nusers=0

call lineout tempfile, ' <hr> <h2> List of virtual directories </h2>  '

call lineout tempfile,' Notes: <ul> '
call lineout tempfile,' <li> Virtual directories are stored in: ' virtualfile
call lineout tempfile,' <li> <em>Comments are in italics </em> '
call lineout tempfile, ' <li> Entries with no <strong>host nickname</strong> apply to all requests '
call lineout tempfile, ' <li> Valid keywords for limitation list are: <b> !CGI-BIN !UPLOAD !ADDONS !HTML </B>'
call lineout tempfile, ' <li> For remote (<code>http://</code>) directories, you can add '
call lineout tempfile, ' a user:pwd (to be sent as a request header). This must follow the limitation list and be preceded by a comma </ul> <br> '

call lineout tempfile,' <table border=1> <th> Host Nickname </th>'
call lineout tempfile,' <th> Candidate SEL (abbreviation) </th>'
call lineout tempfile,'  <th> Fully qualified directory (or remote directory)  </th> '
call lineout tempfile,' <th> Allow subdirectories <br> &amp; <code> limitation list , user:pwd </code> </th><tr>'

do mm=iat to lins.0
  if lins.mm=' ' then iterate
  if  abbrev(strip(lins.mm),';') then do  
       call lineout tempfile,'<td colspan=4>  <code>     </code> <em>' strip(strip(lins.mm),'l',';') '</em></td> <tr> '
  end
  else do
      if pos('// ',lins.mm)>0 then
           parse var lins.mm hostname '//' candurl targdir limlist
      else do
           hostname=' .. '
           parse var lins.mm candurl targdir limlist
      end  /* Do */
      subdirok='NO'
      if right(strip(targdir),1)='*' then do
         targdir=delstr(targdir,length(targdir))
         subdirok='YES'
      end
      call lineout tempfile,'<td> <STRONG> 'hostname '</STRONG> </td>'
      call lineout tempfile,'<td> <STRONG> ' candurl '</STRONG> </td>'
      call lineout tempfile,'<td> <STRONG> 'targdir '</STRONG> </td>'
      call lineout tempfile,' <td> <strong> ' subdirok '</strong> <br> '
      call lineout tempfile,'  <code> ' limlist '</code> </td> <tr> '

  end /* do */

end
call lineout tempfile,' </table>'

call lineout tempfile,' <hr> Thanks for checking </body></html>'
call lineout tempfile

foo=sref_gos('file erase  type text/html name  ' tempfile)
return ' done '


/* jump here if "show current" chosen */
showcurrent:
foo=wait_queue('VIRTUAL')
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
call lineout tempfile, "<html><head><title>SRE-http: list of virtual directories </title>"
call lineout tempfile, '</head><body  bgcolor="#'||usecolor||'">'

call lineout tempfile, '<h2>List of SRE-http VIRTUAL directories </h2>'
call lineout tempfile,' This complete list of VIRTUAL directories includes entries in default and host specific copies '
call lineout tempfile,' of VIRTUAL.IN and ATTRIBS.CFG <hr width="30%">'
call lineout tempfile,'<table border=1>'
call lineout tempfile,'<tr><th> Host <th> Selector <th> Directory  <em>(SubDir Ok?)</em>'
call lineout tempfile,'<th>Username/pwd &amp; <br> Limitlist'

do forever
  if foo='' then leave
  parse var foo ah '//' vu  ','  vd ',' vs ',' upwd ',' vlimit (crlf) foo
  parse var vlimit . ',' vlimit
  call lineout tempfile,'<tr><td> 'ah '<td> 'vu '<td> 'vd 
  if vs=1  then call lineout tempfile,' <em> (ok) </em>'
  call lineout tempfile,' <td> <tt>'upwd '</tT> <br> 'vlimit
end
call lineout tempfile,'</table></body></html>'
call lineout tempfile
foo=sref_gos('file erase  type text/html name  ' tempfile)
return ' done '


           dog1=dog1||virthosts.mm '// ' virturl.mm' , 'virtdir.mm ','virtsubs.mm||' , '
           dog1=dog1||virtdir.mm.!upwd' , 'virtdir.mm.limitlist||'0d0a'x
  



/* jump here if "set values" chosen */
doset:
virtualfile=value(enmadd||'virtual_FILE',,'os2environment')
aa=sref_fileread(virtualfile,'lins',,'E')

call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
call lineout tempfile, "<html><head><title>SRE-http: modify virtual directorires </title>"
call lineout tempfile, '</head><body  bgcolor="#'||usecolor||'">'

call lineout tempfile,'<!--  a button bar. --> 'crlf ,
           '<a href="/configur.htm">Configurator</a>||' crlf ,
           '<a href="/config2?todo=SET">Parameters</a>||' crlf ,
           '<a href="/usercfg?todo=SET">Usernames</a>||'  crlf ,
           '<a href="/realmcfg?todo=SET">Define-Realms</a>||'||crlf ,
           '<a href="/accescfg?todo=SET">Access-Controls||'  crlf ,
           '<a href="/aliascfg?todo=SET">Aliases</a>||'  crlf ,
           '<a href="/virtcfg?todo=SET">VirtualDir</a><p>'  


/* ignore header stuff */
iat=0
do until iat >= lins.0
   iat=iat+1
   if  abbrev(strip(lins.iat),';') | lins.iat=' ' then iterate
   leave
end /* do -- iat is the first non header comment line  */
call lineout tempfile, "<h1> SRE-http: modify <A NAME="top">virtual</A> directories </h1> <p>"
call lineout tempfile,' <blockquote> You can modify, remove, or add virtual directories'
call lineout tempfile,' <br><em> Questions? <A HREF="#notes">The notes might help.</A> </em> </blockquote> '

call lineout tempfile,' <h2> Modify or remove current virtual directories </h2>'
call lineout tempfile,'<FORM ACTION="/virtcfg" METHOD="POST">'

call lineout tempfile,' <table border=1> <th> Host Nickname <br> (see below  for a <br>listing of <A href="#hosts">current hosts</A>)  </th>'
call lineout tempfile,' <th> Candidate SEL abbreviation <br> (set to blank to  delete the entry)</th>'
call lineout tempfile,'  <th> Local or remote directory   </th> '
call lineout tempfile,' <th> Allow subdirectories; <br> and optional limtation_list , user:pwd? </th><tr>'

nhidden=0 ; mm=0
do mm0=iat to lins.0
    alin=translate(lins.mm0,' ','1a000d0a'x)
    mm=mm+1
    if  abbrev(strip(alin),';')=1 | alin=' ' then do
        nhidden=nhidden+1
        hiddens.nhidden='<INPUT TYPE="HIDDEN" name="COMMENT.'||mm||'"  value="'||alin||'" >'
        iterate
    end

/* non comment */
    if pos('// ',alin)>0 then
             parse var alin hostname '//' candurl absdir limlist
        else do
             hostname='  '
             parse var alin candurl absdir limlist
     end  /* Do */
     candurl=strip(candurl)
     subdirok=0
     if right(strip(absdir),1)='*' then do
         absdir=delstr(absdir,length(absdir))
         subdirok=1
     end
     call lineout tempfile,'<td> <EM>Host nickname:</EM> <br> <INPUT TYPE="text" NAME="hostname.'||mm||'"'
     call lineout tempfile,'value="'hostname'" SIZE=8 MAXLENGTH=15> </td> '
     call lineout tempfile,'<td> <EM>Candidate:</EM> <br> <INPUT TYPE="text" NAME="candurl.'||mm||'"'
     call lineout tempfile,'value="'candurl'" SIZE=18 MAXLENGTH=55> </td> '
     call lineout tempfile,'<td> <EM>Target:</EM> <br> <INPUT TYPE="text" NAME="absdir.'||mm||'"'
     call lineout tempfile,'value="'absdir'" SIZE=18 MAXLENGTH=55> </td> '
     call lineout tempfile,'  <td> <INPUT TYPE=CHECKBOX NAME="subdirok.'mm||'" '
     if subdirok=1 then
          call lineout tempfile,' CHECKED >Sub directories ok? <br> '
     else
         call lineout tempfile,' > Sub directories ok? <br> '
     call lineout tempfile,' <br>'
     call lineout tempfile,'<br> <EM>Limitation_list , user:pwd:</EM> <br> <INPUT TYPE="text" NAME="limlist.'||mm||'"'
     call lineout tempfile,'value="'limlist'" SIZE=12 MAXLENGTH=35> </td> '


     if mm0<lins.0 then do
           call lineout tempfile,'<tr>' ; call lineout tempfile,' '
     end
end
call lineout tempfile,' '

/* --- allow user to enter a few new names */
call lineout tempfile,' </table>  <p> <h2> Add virtual directories </h2> <table border=1>'
mm0=mm
do mm=mm0+1 to mm0+3
     call lineout tempfile,'<td> <EM>Host nickname:</EM> <br> <INPUT TYPE="text" NAME="hostname.'||mm||'"'
     call lineout tempfile,'value=" " SIZE=8 MAXLENGTH=15> </td> '
     call lineout tempfile,'<td> <EM>Candidate SEL:</EM> <br> <INPUT TYPE="text" NAME="candurl.'||mm||'"'
     call lineout tempfile,'value=" " SIZE=18 MAXLENGTH=55> </td> '
     call lineout tempfile,'<td> <EM>Fully qualified directory:</EM> <br> <INPUT TYPE="text" NAME="absdir.'||mm||'"'
     call lineout tempfile,'value=" " SIZE=18 MAXLENGTH=55> </td> '

     call lineout tempfile,'  <td> <INPUT TYPE=CHECKBOX NAME="subdirok.'mm||'"> Sub directories ok? '
     call lineout tempfile,'<br> <EM>Optional limitation_list , user:pwd :</EM> <br> <INPUT TYPE="text" NAME="limlist.'||mm||'"'
     call lineout tempfile,'value=" " SIZE=14 MAXLENGTH=35> </td> '

     if mm<mm0+3 then call lineout tempfile,' <tr> '
end

call lineout tempfile,'</table> <p>'


/* ----- add comments information */

do jj=1 to nhidden
   call lineout tempfile,hiddens.jj
end /* do */
call lineout tempfile,' <input type="hidden" name="entries" value="'||mm||'">'
call lineout tempfile,' <input type="submit"> <input type="reset"> </form> '


call lineout tempfile,' <hr> <h3> <A NAME="notes">Notes </A></h3> <ul> <li> Virtual directories are stored in: 'virtualfile
call lineout tempfile,' <li> If a  <em>candidate SEL</em> is an abbreviation for a <em>request selector</em>, '
call lineout tempfile,' <br> the associated <em>fully qualified directory </em> is used.'
call lineout tempfile,' <li> The <em>optional </em> limitation_list can contain any of the following: <b> !HTML !ADDONS  !CGI-BIN !UPLOAD </b>'
call lineout tempfile,' <li> To specify a "remote" directory (on another server), use a fully specified (http://...) URL '
call lineout tempfile,' as the <em>fully qualified directory </em> '
call lineout tempfile,' <br> The <em>optional</em> user:pwd can contain a user:pwd (i.e.; JOE:MONSTER). This is <u>only</u> '
call lineout tempfile,' used with remote virtual directories. It must follow the limitation list and be preceded by a comma.'

call lineout tempfile,' <li> Do you want to view a  more complete description of '
call lineout tempfile,' <a href="/samples/in_files.doc"> virtual directories </a>?'
call lineout tempfile,' <li>View the <a href="/virtcfg?TODO=CURRENT"> current set of  virtual directories </a>?'

call lineout tempfile,' <li> To add more then 3 new virtual directories, just rerun this several times, <br> or edit ' virtualfile
call lineout tempfile,' <li> <em>Comments are NOT displayed </em>  <li> Case is ignored '
call lineout tempfile,' <li> Selecting <em>subdirectories ok </em> permits access to the subtree under the <em>fully qualified directory </em>'
call lineout tempfile, ' <li> Entries with no <strong>host nickname</strong> will apply to all requests</ul> <br>'


call lineout tempfile,' <h3> A list of the <A NAME="hosts">current hosts</A> </h3>  <blockquote> '
ii=value(enmadd||'HOSTS.0',,'os2environment')
if ii=0 then do
   call lineout tempfile,'<strong>There are no hosts defined</strong>'
end 
else do
  hlist=sref_value('$HOSTS.0',,'USE')
  call lineout tempfile,' <table> <th> IP address </th> <th> Host Nickname </th> <th> Data Directory </th> <tr> '
  do ll=1 to words(hlist)
      hh=strip(translate(word(hlist,ll)))
      wow=sref_value('$HOSTS.'||hh,,'use')
      parse var wow ip ',' hn ',' hdir
     call lineout tempfile,' <td> ' ip  '</td> <td> ' hn ' </td> <td> ' hdir '</td> <tr> '
  end /* do */
  call lineout tempfile,' </table> </blockquote>'
end

call lineout tempfile,' <p> <A HREF="#top">Return to the top of this form.</A>'

call lineout tempfile,'</body></html>'
call lineout tempfile

foo=sref_gos('file erase  type text/html name  ' tempfile)
return ' done '



/******************** jump here to recrod changes */
dochange:
parse upper var list foo 'ENTRIES=' nentries '&' .
do ii1=1 to nentries
   fillme.ii1.0=0
end /* do */

do until list=""
   parse var list aa '&' list
   parse upper var aa avar '.' aind '=' aval
   aval=packur(aval)
   if abbrev(avar,'ENTRIES=')=1 then iterate
   wow=fillme.aind.0+1
   fillme.aind.0=wow
   fillme.aind.wow.var=avar ; fillme.aind.wow.val=aval
   select
      when avar="COMMENT" then do
          fillme.aind.type='COMMENT'
          parse  var aa foo '=' aval
          fillme.aind.wow.val=packur(aval)
      end
      when avar="CANDURL" then fillme.aind.type='URL'
      otherwise nop
   end
end /* do */

virtualfile=value(enmadd||'virtual_FILE',,'os2environment')
aa=sref_fileread(virtualfile,'lins',,'E')

/* pull "header comments" */
iat=0
do until iat >= lins.0
   iat=iat+1
   if  abbrev(strip(lins.iat),';')  then do
       newlines.iat=lins.iat
   end  /* Do */
   else do
        leave
   end
end /* do -- iat is the first non header comment line  */
iat=iat-1

do uu=1 to nentries
   select
      when fillme.uu.type='COMMENT' then do
          iat=iat+1
          newlines.iat=fillme.uu.1.val
      end
      when fillme.uu.type='URL' then do
          candurl=' ' ; absdir=' ' ; hostname=' ';subdirok=' ';limlist=" "
          do uu2=1 to fillme.uu.0
             chk1=fillme.uu.uu2.var
             vvv=fillme.uu.uu2.val
             select
                when chk1='CANDURL' then candurl=vvv
                when chk1='ABSDIR' then absdir=vvv
                when chk1='HOSTNAME' then hostname=vvv
                when chk1="LIMLIST" then limlist=vvv
                when chk1='SUBDIROK' then subdirok='*'
                otherwise nop
             end
          end
          if candurl<>' ' then do
              iat=iat+1
              newlines.iat=''
              if hostname<>' ' then
                  newlines.iat=hostname||'// '
              if subdirok='*' then do
                  if pos('HTTP:',upper(absdir))>0 then
                      absdir=strip(absdir,'t','/')||'/'
                  else
                      absdir=strip(absdir,'t','\')||'\'
               end
              newlines.iat=newlines.iat||candurl' ' absdir||subdirok||' '||limlist
          end
      end
      otherwise do
            nop
      end  /* Do */

  end                   /* select over type */
end                     /* do over entries */

/* save to virtualfile.. but rename access_file first */
foo=lastpos('.',virtualfile)
if foo=0 then
   acf1=virtualfile||'.'
else
   acf1=left(virtualfile,foo)
do hi=1 to 999
   try1=acf1||hi
   if stream(acf1||hi,'c','query exists')='' then leave
end /* do */
foo=dosrename(virtualfile,try1)
newlines.0=iat
foo=sref_filewrite(virtualfile,newlines,'R')


call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
call lineout tempfile, "<html><head><titLE> SRE-http: Changed the virtual directories</title>"
call lineout tempfile, '</head><body  bgcolor="#'||usecolor||'">'

call lineout tempfile,' <h2>The virtual directories have been changed </h2>'
call lineout tempfile,' The list of virtual directories has been saved to: ' virtualfile
call lineout tempfile,' <p> The old version of 'virtualfile' has been moved to ' try1
call lineout tempfile,'<p> <a href="/config2.htm">Return to Intermediate Mode Configurator</a>'

call lineout tempfile,' </body> </html> '
call lineout tempfile

foo=value('SREF_REDO',1,'os2environment')


foo=sref_gos('FILE ERASE TYPE text/html NAME' tempfile)
return 'done change '




/* ------------------------------------------------------ */
/* query and wait on helper thread */
/* ------------------------------------------------------*/
wait_queue:procedure expose enmadd transaction semqueue host_nickname
parse arg athread
again1t:

parse var semqueue mysem myqueue

basesem='\SEM32\'||enmadd

goober=enmadd||athread
 a=rxqueue('s',goober)
 queue  transaction ' ' host_nickname ',' myqueue ',' mysem ', *LIST* '

  a=eventsem_reset(mysem)
  dothread=basesem||athread

  a=eventsem_post(dothread)
again2t:
  a=eventsem_wait(mysem,90000)  /* max wait of 90 seconds */

  if a<>0 then do
        ss=sref_error(mytid','athread' A Fatal Semaphore failure: 'a,1)
        'response HTTP/1.1 503 Service Unavailable'
        String 'Web server is temporarily busy '
        exit ' '
  end
  a=rxqueue('s',myqueue)

  parse pull aline

  PARSE VAR ALINE idnum ',' aline
  idnum=strip(translate(idnum,' ','000d0a'x));TRANSACTION=STRIP(TRANSACTION)
  if idnum<>transaction then  do /*wierd error: got someone else's message! */
        ss=sref_error(mytid','athread' A  Semaphore failure: 'a,1)
        'response HTTP/1.1 503 Service Unavailable'
        String 'Web server is temporarily busy '
        exit ' '
  end

  return aline



