/* check stuff for a candidate selector */

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

if verb=" " then do
   say "This SRE-http procedure is not meant to be run in standalone mode "
   exit
end  /* Do */

myaddr=extract('CLIENTADDR')
/* if no username and password provided, get current ones */
foo=sref_extract_upwd()
parse var foo username ':' password
anarg=a1' 'a2' 'anip

list=translate(packur(list),' ','+'||'0d0a09'x)

do until list=''
   parse var list a1 '&' list
   parse var a1 avar '=' aval;avar=upper(strip(avar))
   select
      when avar='TESTURL' then asel0=strip(aval)
      when avar='TESTCLIENT'  then myaddr=strip(aval)
      when avar='USERNAME' then username=strip(aval)
      when avar='PASSWORD' then password=strip(aval)
      otherwise nop
   end
end /* do */


parse var semqueue mysem myqueue
mysem=strip(mysem); myqueue=strip(myqueue)
parse var asel0 asel '?' .
asel=strip(asel)

stuff=get_host_info(protocol,asel)
host_nickname=strip(host_nickname); ddir=strip(ddir)
servername=strip(servername)



/* check for clientaddr argument. if none, use own */
basesem='\SEM32\'||enmadd
os2e='os2environment'
mytid=dostid()
no_virtual=0
tempdata_dir=get_value('TEMPDATA_DIR',0)
serverport=extract('serverport')

myname=sref_clientname(myaddr,mysem,myqueue,basesem,enmadd,transaction)

owners=get_value('OWNERS')
badips=get_Value('UNALLOWEDIPS')


protocol=extract('clientprotocol')

/* write some details */
    
  call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  call lineout tempfile, "<html><head><title>Checking selector </title>"
  call lineout tempfile, "</head><body>"
  call lineout tempfile,' <h2>Checking selector: &nbsp; &nbsp;'asel0' </h2><hr>'
  call lineout tempfile,'<a href="'asel0'">'asel0'</a><p>'
  call lineout tempfile,' <menu><li> <b>Servername: </b> <tt>'servername'</tt>'
  call lineout tempfile,' <li> <b>w/host nickname: </b> <tt>'host_nickname'</tt>'
  call lineout tempfile,' <li> <b>and data directory: </b> <tt>'ddir'</tt>'
  call lineout tempfile,'</menu> '
  call lineout tempfile,' <b>Your client address: </b><tt>' myaddr'</tt>'
  call lineout tempfile,'<menu><li><b> Client name= </b><tt>' myname'</tt>' 
  call lineout tempfile,' <li> Your username/password: <tt>'username ',' password '</tt>'

  if username<>'' & password<>'' then do
      aline=wait_queue('USER','BASIC 'username' 'password)
      parse var aline isgot privset1
      call fix_privset1
      if isgot>=1 then do
         call lineout tempfile,'<br>   with client privileges = 'privset1
         if privset1_secret<>'' then
           call lineout tempfile,'(and '||words(privset1_secret)||' secret privileges)'
      end
      else do
         call lineout tempfile,' <br> no match to this username/password '
      end
     call add_privs_2
     call lineout tempfile,' <li><b>Other privileges:</b> <tt>'upper(privset) '</tt>'
  end



  mdo=0
  if badips=1 then do
     mdo=sref_badips(myaddr,enmadd,host_nickname)
     is_public=0
  end
  if mdo=1 then call lineout tempfile,' This is a UNALLOWEDIPS <p>'
  if wordpos(who,owners)>0 then call lineout tempfile,' This is an OWNER '
  call goodips myaddr
  if result=1 then call lineout tempfile,' <li>This an INHOUSEIPS'
  call lineout tempfile,'</menu>'        


 if abbrev(asel,'!')=1 then do
     call lineout tempfile,'<B> The selector is a special request '
     call lineout tempfile,'</body><html>'
     call lineout tempfile
     call sref_gos('FILE type text/html name ' tempfile)
     return ' '
 end /* do */

 sreproxy=value('SREF_PROXY',,'os2environment')
 if sreproxy=1 then do
   dd=check_cache(host_nickname,asel)
   if strip(translate(dd,' ','0d0a09'x))<>0 then do
       parse var dd . '0d0a'x cfile .
      call lineout tempfile,' <b>SRE-Proxy using = </b><tt>'cfile '</tt><p>'
   end /* do */
 end

 foo2=value(enmadd||'PUBURL_FILE')      /* any public urls to check? */
 if foo2<>"" then do
    aline=wait_queue('PUBURL',asel)
    if aline<>0 then
       call lineout tempfile,'<b> Public Url Match:</b><tt> 'aline '</tt><p>'
  end


/*  6) now check ACCESS file */

  aline=wait_queue('ACCESS','++:'||asel,'NO')
  parse var aline istat ',' accprivs ',' accopts ',' urlrealm ',' afail_file ',' adv_opts
  parse var istat istat istatname; istat=strip(istat)
  accopts=space(strip(upper(translate(accopts,' ','09'x))),1)
  accprivs=space(strip(upper(translate(accprivs,' ','09'x))),1)

  if istat=0 then
    call lineout tempfile,' <u>Access status</u>=<tt> no match</tt>'
  else
    call lineout tempfile,' <u>Access status</u>: match entry 'istat '=<tt>' istatname'</tt>'

  if istat>0 then do
   call lineout tempfile,'<ul><li><b>Resource privileges: </b><tt>'accprivs'</tt>'
   call lineout tempfile,'   <li><b>Resource permissions: </b><tt>'accopts'</tt>'
   call lineout tempfile,'   <li><b>Resource realm: </b><tt>'urlrealm'</tt>'
   call lineout tempfile,'   <li><b>Access fail file: </b><tt>'afail_file'</tt>'
   if adv_opts<>'' then do
      call lineout tempfile,'   <li><b>Advanced options file: </b><tt>'adv_opts'</tt><pre>'
      call get_adv_opts
      call lineout tempfile,adv_opts'</pre>'
   end
   call lineout tempfile,'</ul>'
  end

/*  8a) is it for the  DEFAULT "home page" 
        (relative to datadir, No virtual directory  lookups! */

 if asel=' '  then do
      sel=sref_get_default(default,ddir,verbose,myqueue) /* always relative to datadir */
      call lineout tempfile,' Using Default (home page): <tt>'sel'</tt>'
 end

/* Now see if the ACTION is really an alias for some other action */

aline=wait_queue('ALIAS','++:'||asel)
parse var aline istat newsel
parse var istat istat ':' istatname

if istat>0 then do
  call lineout tempfile,'<b> Alias match to entry</b> 'istat'=<tt>' istatname '</tt>'
  CALL LINEOUT TEMPFILE,'<MENU><LI> Match to: <tt>'||strip(word(newsel,1))||'</tt>'
  CALL LINEOUT TEMPFILE,'<LI> which resolves to: <tt>'||strip(word(newsel,2))'</ul>'
end
else do
  call lineout tempfile,'<u> <b>No</b> alias match </u>'
end

 
action=asel
foo1=pos('~',action)
if foo1>0 then do            /* do ~ for home_dir replacement, with $ option */
  action=sref_home_dir(action,home_dir)
  action=strip(action,'l','/')
  call lineout tempfile,' <br>~ replacement yields: <tt>'action '</tt>'
end


icgi=pos('CGI-BIN/',upper(asel))
if icgi>0 then do
  cgi_bin_dir=STRIP(get_value('CGI_BIN_DIR',0))
  aselc=substr(asel,icgi+8)
  afilenam=sref_do_virtual(cgi_bin_dir,aselc,enmadd,0,transaction,HOMEDIR,HOST_NICKNAME)
  call lineout tempfile,'<p> <u> Mapping to virtual directory</u> (cgi-bin_dir default):' afilenam
  afilenam=sref_do_virtual(cgi_bin_dir,aselc,enmadd,1,transaction,HOMEDIR,HOST_NICKNAME)
  if afilenam=0 then   /* try adding .cmd */
      afilenam=sref_do_virtual(cgi_bin_dir,aselc'.cmd',enmadd,1,transaction,HOMEDIR,HOST_NICKNAME)
  if afilenam=0 then   /* try adding .cmd */
      afilenam=sref_do_virtual(cgi_bin_dir,aselc'.'serverport,enmadd,1,transaction,HOMEDIR,HOST_NICKNAME)
  if afilenam=0 then call lineout tempfile,'<em>(was not found) </em>'
end /* do */
else do


  qpos=pos('?',asel0)>0 ;afilenam=1
  if qpos>0 then do
    addon_dir=get_value('ADDON_DIR',0)
    afilenam=sref_do_virtual(addon_dir,asel,enmadd,0,transaction,HOMEDIR,HOST_NICKNAME)
    call lineout tempfile,'<p> <u> Mapping to virtual directory</u> (addon_dir default):' afilenam
    afilenam=sref_do_virtual(addon_dir,aselc,enmadd,1,transaction,HOMEDIR,HOST_NICKNAME)
    if afilenam=0 then   /* try adding .cmd */
      afilenam=sref_do_virtual(addon_dir,asel'.cmd',enmadd,1,transaction,HOMEDIR,HOST_NICKNAME)
    if afilenam=0 then   /* try adding .cmd */
      afilenam=sref_do_virtual(addon_dir,asel'.'serverport,enmadd,1,transaction,HOMEDIR,HOST_NICKNAME)
    if afilenam=0 then call lineout tempfile,'<em>(was not found) </em>'
  end

  if  \(afilenam<>1 & pos('.',asel0)=0) then do
    afilenam=sref_do_virtual(ddir,asel,enmadd,0,transaction,HOMEDIR,HOST_NICKNAME)
    call lineout tempfile,'<p> <u> Mapping to virtual directory</u> (datadir default):' afilenam
    afilenam=sref_do_virtual(ddir,asel,enmadd,1,transaction,HOMEDIR,HOST_NICKNAME)
    if afilenam=0 then call lineout tempfile,'<em>(was not found) </em>'
  end


end

 call lineout tempfile,'</body><html>'
 call lineout tempfile
 call sref_gos('FILE ERASE type text/html name ' tempfile)
 return ' '


/******************* END OF MAIN  **************************/

/* ------------------------------------------------------ */
/* query and wait on helper threads */
/* ------------------------------------------------------*/
wait_queue: procedure expose os2e mysem myqueue enmadd basesem  ,
          mytid verbose transaction no_virtual servername host_nickname 

parse arg athread,args,extra1
athread=strip(athread) ; args=strip(args)
/* check to see if no need to call queue */

again1t:
goober=enmadd||athread
  a=rxqueue('s',goober)
  queue  transaction ' ' host_nickname ',' myqueue ',' mysem ','  ARGS
  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 in checksel: 'a,1)
        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! */
      say ' Read odd id from queue 'athread ':' transaction ',' idnum
      if eventsem_query(mysem)=1 then aa=eventsem_reset(mysem)
     signal again2t
  end

  aline=strip(aline)
  return aline






/* -----------------------------------------------------------------------*/
/* see if ip address matches one of a set of good ips (1 if yes)*/
/* check for numeric or names ,and check for wildcards */
/* if non-default host, ONLY get "Host specific" inhouseips */
/* -----------------------------------------------------------------------*/
goodips: procedure expose inhouseips. privset1 enmadd os2e verbose  transaction servername host_nickname ,
                   clientname0 mysem myqueue basesem who


parse arg anips

anips=strip(anips) ;hostn=strip(host_nickname)

if symbol(inhouseips.0)<>"VAR" then do  /* not been read yet */
   aa='inhouseips.' ;addit=''
   if hostN<>"" then addit='.'||hostn
   nin=0
   do mm=1 to 10000
      useme=enmadd||aa||mm||addit ; useme=strip(useme)
      tt=strip(value(useme,,os2e))
      if tt="" | tt=0 then leave
      nin=nin+1 ; inhouseips.nin=upper(tt)
   end
   inhouseips.0=nin
end

/* check exact matches -- perhaps name matches */
mdo=inhouseips.0
do mm=1 to mdo
  if inhouseips.mm=' '  then iterate
  if verify(word(inhouseips.mm,1),'*1234567890.')=0 then do  /*a numeric ip */
     if strip(word(inhouseips.mm,1))=anips then do        /*it's an exact match -- extract privset */
        parse var inhouseips.mm ff  privset1
        return 1
    end
  end
  else do                      /* a name ip */
      if clientname0=0 then 
            clientname0=sref_clientname(who,mysem,myqueue,basesem,enmadd,transaction)
      if strip(word(inhouseips.mm,1))=clientname0 then do        /*it's an exact match -- extract privset */
         parse var inhouseips.mm ff  privset1
         return 1
      end
  end           /* name or number inhouseip */
end

/* if here, try wild card matches */
do m2=1 to mdo           /* wild card matches */
    imm=sref_wild_Match(anips,inhouseips.m2)
    if imm=0 & clientname0<>0 then 
        imm=sref_wild_match(clientname0,inhouseips.m2)
    if imm=0 then iterate
    parse var inhouseips.m2 . privset1
    return 1
end
return 0                /* no match */




/* ----------- */
/* get environment value, possibly host specific
hname=0 -- do not look under hostname
hname=1 -- do not look under default
 */
/* ------------ */
get_value: procedure expose enmadd host_nickname
parse upper arg vname,hname0
if hname0=0 then
        hname=' '
else
    hname=strip(host_nickname)

vname=strip(vname) ;
if hname<>' ' then do
   booger=strip(enmadd||vname||'.'||hname)
   aval=value(booger,,'os2environment')
   if aval<>' ' | hname0=1 Then
        return aval
end
aval=value(enmadd||vname,,'os2environment')
return aval




/******/
/* syntax error */
goterr:
IF RC=-7 THEN EXIT ' '  /* if just  a closed connection ,then don't worry */
LL=SIGL
glue='SRE-http error at line 'll '(rc= 'rc

if rxfuncquery('PMPRINTF')=1 then do
    say glue
end
else do
  if macroquery('sref_error')=' ' then
    say glue
  else
    ss=sref_error(glue,1)
end
IF COMPLETED()=0 THEN
   'var type text/plain name glue'


exit  ' '


/********************************/
/* check on advanced options */
get_adv_opts:
if adv_opts<>" " then do
      wd=get_value(workdata_dir)
      foo=strip(wd,'t','\')||'\'||strip(adv_opts)
      adv_opts_file=stream(foo,'c','query exists')
      if adv_opts_file="" then do
         adss= sref_error("Warning: missing advanced options file: " foo " ("asel,1)
      end
      else do
         adv_opts=charin(adv_opts_file,1,chars(adv_opts_file))
      end
end
return 1




/*********************/
/* get host,datadir, & servername for this requesete */
get_host_info:procedure expose host_nickname ddir servername  asel enmadd myaddr
parse arg protocol,asel


stuff=sref_host_info(myaddr,enmadd,asel,protocol)
if strip(stuff)='BAD' then return -1           /* if http/1.1 client did not include at host: header */

if stuff<>0 then do
      parse var stuff  servername ',' host_nickname  ',' ddir
      host_nickname=strip(host_nickname); ddir=strip(ddir)
      servername=strip(servername)
end
else do
    ddir=datadir()
    servername=servername()
    host_nickname=' '
end
if abbrev(upper(asel),'HTTP://')>0 then do
          parse var uri . '//' . '/' uri
          if uri='' then uri='/'
          parse var asel . '//'  . '/' asel
end        
return 1

/*****************************************/
/* add privileges from various sources */
add_privs_2:
privset=''
/* add public_privs to everyone */
 public_privs=get_value('public_privs')
 privset=privset||' '||public_privs

/* add "username " to privset (this step may be redundant, but... ? */
addname=get_value('add_user_name')
if addname=1 then do
  if wordpos(upper(username),upper(privset))=0 then
       privset=privset||' '||username
end

/* check for dynamic privileges ? */
check_add_privs=get_value('CHECK_ADD_PRIVS')
if check_add_privs=1 then do
       aprefix=strip(get_value('ADD_PRIVS_PREFIX'))
       ap2=sref_get_add_privs(host_nickname,myaddr,serverport,enmadd,tempdata_dir,verbose)
       do iw=1 to words(ap2)
          privset=privset||' '||aprefix||strip(word(ap2,iw))
       end
       privset=translate(privset,' ','&')  /* correct entry errors */
end



return privset

/********************************/
/* check on advanced options */
get_adv_opts:
      wd=get_value(workdata_dir)
      foo=strip(wd,'t','\')||'\'||strip(adv_opts)
      adv_opts_file=stream(foo,'c','query exists')
      if adv_opts_file="" then return " No such file: "adv_opts
      return charin(adv_opts_file,1,chars(adv_opts_file))


/********************************/
/* checks sreproxy cache */
check_cache:procedure expose enmadd mysem myqueue transaction 
parse arg hname,sel

if left(sel,1)='!' then do
  if abbrev(upper(sel),'!SEND')<>1 then return 0  /* do NOT cache special codes */
end

if hname<>'' then
  eek=hname'//'sel
else
  eek=sel
eek=upper(eek)
goober='SREF_SREPROXY'
a=rxqueue('s',goober)
queue  transaction','myqueue','mysem',L,'EEK
a=eventsem_reset(mysem)
dothread='\SEM32\SREF_SREPROXY'
a=eventsem_post(dothread)

a=eventsem_wait(mysem)
if a<>0 then do
   sss=sref_error(' A Fatal Semaphore failure in checksel: 'a,1)
   return -1
end
a=rxqueue('s',myqueue)

parse pull aline
PARSE VAR ALINE idnum ',' aline

idnum=strip(translate(idnum,' ','000d0a'x))
if idnum<>transaction then  do /*wierd error: got someone else's message, give up */
      say ' Read odd id from checksel :' idnum0 ',' idnum
      return -1
end

aline=strip(aline)
return aline

/****************************/
/* remove repeats, extract secret privileges.
  This will modify privest, and create privset1_secret and privset12 */
fix_privset1:
p1=''
secp1=''
privset1=translate(translate(privset1,' ',','||'0d0a0900'x))
do mm=1 to words(privset1)
   aw1=strip(word(privset1,mm))
   if abbrev(aw1,'?')=1 then do
     aw1=substr(aw1,2)
     if wordpos(aw1,secp1)=0 then secp1=secp1||aw1||' '
   end
   else do
      if wordpos(aw1,p1)=0 then p1=p1||aw1||' '
   end
end
privset1=p1
privset1_secret=secp1
return 1




