SREFILTER ERROR

/* */ aliascfg: CHECKIT=0 /* Change this to 0 if you want to enable REMOTE configuration */ /* 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 if verb="" then do say " This SRE-Filter 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. */ who2=extract('CLIENTADDR') saddr2=extract('SERVERADDR') select when checkit=1 then do /* only if user = serveraddress !!! */ if who2<>saddr2 then do call lineout tempfile, '' call lineout tempfile, "SREFILTER ERROR " call lineout tempfile, '' call lineout tempfile,' Action not allowed remotely.
'
        call lineout tempfile,'   '
        call lineout tempfile
        'FILE ERASE TYPE text/html NAME' tempfile
        return 'ALIASCFG: action not allowed remotely. '
     end
   end
   otherwise do
      if wordpos('SUPERUSER',privset)=0 then do
        'RESPONSE HTTP/1.0 401 Unauthorized '     /* Set HTTP response line */
        'header add WWW-Authenticate: Basic Realm='  /* challenge */

        call lineout tempfile, ''
        call lineout tempfile, "Not authorized "
        call lineout tempfile, ''


        call lineout tempfile,'  You do not have configuration rights. '
        if who2=saddr2 then 
                call lineout tempfile,'
  You may want to edit USERCFG.CMD  '
        call lineout tempfile,'   '
        call lineout tempfile
         iia=dosdir(tempfile,'s')
        'FILE ERASE TYPE text/html NAME' tempfile
        return '401 'iia' ALIASCFG: 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
   otherwise
        signal dochange
end  /* select */

/* jump here to show values */
doshow:

aliasfile=value(enmadd||'ALIAS_FILE',,'os2environment')
   call lineout tempfile, ''
   call lineout tempfile, "SRE-Filter redirection aliases "
   call lineout tempfile, ''


aa=go_fileread(aliasfile)  /* expose lins */

/*aa=fileread(aliasfile,'lins',,'E') */

call lineout tempfile, " SRE-Filter:  Redirection aliases    
 "
if upper(list)="TODO=SHOW"  then
   call lineout tempfile, "
 List of "header" comments 
  "
else
   call lineout tempfile, " Description of redirection aliaases 
  "


/* 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, ' '

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

/* read in aliases, etc */
nusers=0
call lineout tempfile, '
 List of redirection aliases  '
call lineout tempfile,' Notes:  '
call lineout tempfile,'  Aliases are stored in: ' aliasfile
call lineout tempfile,' 
 Comments are in italics  '
call lineout tempfile,' 
 The * character is used as a wildcard (for an arbitrarily long string)'
call lineout tempfile, ' 
 Entries with no host nickname apply to all requests
 
'
call lineout tempfile,' '
call lineout tempfile,' '
call lineout tempfile,'  '

do mm=iat to lins.0
  if lins.mm=' ' then iterate
  if  abbrev(strip(lins.mm),';') then do  
       call lineout tempfile,' '
  end
  else do
      if pos('// ',lins.mm)>0 then do
           parse var lins.mm hostname '//' candurl targurl
      end
      else do
           hostname=' .. '
           parse var lins.mm candurl targurl
      end  /* Do */
      if length(targurl) > 55 then do
          iiat2=0 ; moocow='' ; ijoe=length(targurl) 
          do while iiat2 <= length(targurl)
              iiat=iiat2+1
              eek=substr(targurl,iiat,45)
              moocow=moocow||eek||'
'
              iiat2=iiat2+45
          end
          targurl=moocow
      end
      call lineout tempfile,''
      call lineout tempfile,''
      call lineout tempfile,''

  end /* do */

end
call lineout tempfile,'   Host Nickname  Candidate SEL (convert from)  Target of redirection (convert to)  
        ' strip(strip(lins.mm),'l',';') '  
      'hostname '     ' candurl '      'targurl '  
'

call lineout tempfile,'  Thanks for checking '
call lineout tempfile

foo=sref_expire_response(0.05,dosdir(tempfile,'s'))
'file erase  type text/html name  ' tempfile
return ' done '



/* --- jump here to modify values -- */
/* jump here if "set values" chosen */
doset:
aliasfile=value(enmadd||'ALIAS_FILE',,'os2environment')

aa=go_fileread(aliasfile)
/*aa=fileread(aliasfile,'lins',,'E')*/

call lineout tempfile, ''
call lineout tempfile, "SRE-Filter: modify redirection aliases "
call lineout tempfile, ''


/* 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, " SRE-Filter: modify redirection Aliases  
 "
call lineout tempfile,' 
 You can modify, remove, or add redirection aliases.'
call lineout tempfile,' 
 Questions? The notes might help.   '
call lineout tempfile,'  Modify or remove current Aliases '
call lineout tempfile,''
call lineout tempfile,' '
call lineout tempfile,' '
call lineout tempfile,'  '

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=''
        iterate
    end

/* non comment */
    if pos('// ',alin)>0 then
             parse var alin hostname '//' candurl targurl
        else do
             hostname='  '
             parse var alin candurl targurl
     end  /* Do */
     call lineout tempfile,' '
     call lineout tempfile,' '
     call lineout tempfile,' '
     if mm0' ; call lineout tempfile,' '
     end
end
call lineout tempfilem,' '

/* --- allow user to enter a few new names */
call lineout tempfile,'   Host Nickname 
 (see below  for a 
listing of current hosts)  Candidate SEL   (set to blank to  
 delete the entry)  Target SEL    
 Host nickname: 
   Candidate SEL: 
   Target SEL: 
  
   
 Add new redirection aliases  '
mm0=mm
do mm=mm0+1 to mm0+3
     call lineout tempfile,' '
     call lineout tempfile,' '
     call lineout tempfile,' '
     if mm '
end

call lineout tempfile,' Host nickname: 
   Candidate SEL: 
   Target SEL: 
  
 '


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

do jj=1 to nhidden
   call lineout tempfile,hiddens.jj
end /* do */
call lineout tempfile,' '
call lineout tempfile,'    '


call lineout tempfile,' 
  Notes 
   Aliases are stored in: 'aliasfile
call lineout tempfile,' 
 If a request selector matches a candidate SEL, '
call lineout tempfile,' 
 the associated target SEL  is for the (internal or external) redirection'
call lineout tempfile,' 
 To add more then 3 new aliases, just rerun this several times 
 or edit ' aliasfile
call lineout tempfile,' 
 Do you want to view a  more complete description of '
call lineout tempfile,'  aliases ?'
call lineout tempfile,' 
 Comments are NOT displayed   
 Case is ignored '
call lineout tempfile,' 
 Use a *  in the candidate SEL as a wildcard character '
call lineout tempfile,' 
 When a * appears in the candidate SEL.. '
call lineout tempfile,' 
 you can use a *  in the target SEL as a placeholder for the wildcard match '
call lineout tempfile,' 
 A Target SEL being used for external redirection should start with http:// '
call lineout tempfile, ' 
 Entries with no host nickname will apply to all requests
 
'

call lineout tempfile,'  A list of the current hosts 
   '

ii=value(enmadd||'HOSTS.0',,'os2environment')
if ii>0 then do
call lineout tempfile,'  '
do ll=1 to ii
   wow=value(enmadd||'HOSTS.'||ll,,'os2environment')
   parse var wow ip ',' hn ',' hdir
   call lineout tempfile,'  '
end /* do */
call lineout tempfile,'   IP address   Host Nickname   Data Directory  
 ' ip  '   ' hn '   ' hdir '  
 '
end
else do
  call lineout tempfile,' No HOSTS have been defined   '
end

call lineout tempfile,'  Return to the top of this form.'

call lineout tempfile,''
call lineout tempfile

foo=sref_expire_response(0.05,dosdir(tempfile,'s'))
'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  var aa avar '.' aind '=' aval
   avar=upper(avar)
   aval=packur(aval)
   if abbrev(upper(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 */

aliasfile=value(enmadd||'alias_FILE',,'os2environment')
aa=go_fileread(aliasfile)
/*aa=fileread(aliasfile,'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=' ' ; targurl=' ' ; hostname=' ' 
          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='TARGURL' then targurl=vvv
                when chk1='HOSTNAME' then hostname=vvv
                otherwise nop
             end
          end
          if candurl<>' ' then do
              iat=iat+1
              newlines.iat=''
              if hostname<>' ' then
                  newlines.iat=hostname||'// '
              newlines.iat=newlines.iat||candurl' ' targurl
          end
      end
      otherwise do
            nop
      end  /* Do */

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

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


newlines.0=iat
foo=filewrite(aliasfile,newlines,'R')


call lineout tempfile, ''
call lineout tempfile, " SRE-Filter: Changed the aliases"
call lineout tempfile, ''

call lineout tempfile,' 
The aliases have been changed '
call lineout tempfile,' The list of aliases has been saved to: ' aliasfile
call lineout tempfile,'  The old version of 'aliasfile' has been moved to ' try1
call lineout tempfile,'   '
call lineout tempfile

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

foo=sref_expire_response(0.05,dosdir(tempfile,'s'))
'FILE ERASE TYPE text/html NAME' tempfile
return 'done change '




/* read in aliasfile, concatenate  extension lines */
go_fileread:procedure expose lins.
parse arg aliasfile
aa=fileread(aliasfile,'lins0',,'E')
FOO=DO_EXTENDS(0)


/* OLDER "END WITH , " METHOD RETAINED FOR COMPATABILITIES */
ill=0
exton=0
do il=1 to lins0.0
  t1=strip(lins0.il)
  if exton=1 then do
       t1=t1storage||t1
  end
  exton=0 

  if abbrev(t1,';')=0 then do
     if right(t1,2)=' ,' & il < lins0.0 then do
        exton=1
        t1=left(t1,length(t1)-2)
        t1storage=strip(t1)
        iterate
     end
  end

  ill=ill+1
  lins.ill=t1
end /* do */

lins.0=ill
return ill


/************/
/* Redo ulist, by treating lines starting with , as continuation lines */
do_extends:procedure expose lins0.

if lins0.0=0 then return
isnew=1
tmps.1=lins0.1
do mm=2 to lins0.0
   ali=strip(lins0.mm)
   if abbrev(ali,',')=0 then do
        isnew=isnew+1
        tmps.isnew=lins0.mm
    end
    else do
        tmps.isnew=tmps.isnew||substr(ali,2)
    end
end
do mm=1 to isnew
    lins0.mm=tmps.mm
end
lins0.0=isnew
return 0
Host Nickname	Candidate SEL (convert from)	Target of redirection (convert to)
' strip(strip(lins.mm),'l',';') '
'hostname '	' candurl '	'targurl '