home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Spezial / SPEZIAL2_97.zip / SPEZIAL2_97.iso / ANWEND / ONLINE / SREFPRC1 / HTACCESS.SRF < prev    next >
Text File  |  1997-06-30  |  22KB  |  550 lines
  1. /* ----------------------------------------------------------------------- */
  2. /* SREF_DO_HTACCESS --- a bold lifting of Don Meyer's CHECKAUTH & other stuff:
  3.  
  4. This will CHECK all the accessfilenames in the tree underneath
  5. file for access privileges, etc.  
  6.  
  7. For details on how to set up an accessfile, see
  8.      http://w3.ag.uiuc.edu/DLM/GOHTTP/Auth.Guide.html
  9.  
  10.  
  11. REDIRLIST is supported differently (it's checked BEFORE returning,
  12. and only checks the requested file (not the defaultindex)
  13.  
  14. Also note that when dodirs=1, the DIR.xxx variables are returned,
  15. with NO checking of access privileges.
  16. When dodirs=2, same as 1, but return ALL parameters (used by htaccess
  17. configurator)
  18.  
  19. Otherwise, access rights are checked.  
  20. If access is allowed...
  21.   cache_status ',' auto_name_list  is returned:
  22.      cache_status=0 : do NOT cache
  23.      auto_name_list is from the DEFAULTINDEX variable
  24.  
  25. Note that a check on a file that is generated due to a name pulled from
  26. an earlier lookup of a defaultindex will NEVER generate a new defaultindex
  27. (that is, for each request, the first defaultindex found is used)
  28.  
  29. If access if forbidden, then an exit is done (with approriate 
  30.   "forbidden" response )
  31.  
  32.  
  33. */
  34.  
  35. /* ----------------------------------------------------------------------- */
  36. sref_htaccess:
  37.  
  38. /* note: who,name,clientport,port,dir,servername will be determined
  39.          internally if no value is given */
  40.   parse arg sel,file,accessfilename,who,name,clientport,port,dir,SERVERNAME, ,
  41.             TEMPFILE,dodirs
  42.  
  43.   file = translate( file, '/', '\')
  44.  
  45.   dir.exclude=' '
  46.   secured='1'
  47.   PathTo = ''
  48.   rest = file
  49.   retCode = 0
  50.   gotlist=' '
  51.   set=' '
  52.  
  53. /* initialize some variable */
  54. auth.name=' '; auth.type=' ' ; auth.userfile=' ' ; auth.groupfile=' '
  55. auth.index=' '; redirectfile=' '; auth.limit=' '; dir.exclude=' ';
  56. dir.info=' ' ; dir.describe=' ' ; dir.forbid=' ';dir.builder=' '
  57. rx.enablepostprocess=' ' ; rx.builddir=' '
  58.  
  59.  
  60.   owndir=filespec('d',file)||filespec('p',file)
  61.   owndir=upper(translate(owndir,'/','\'))
  62.   owndir=strip(owndir,'t','/')
  63.  
  64. /* find htaccess files;
  65.    and if found, extract the parameters, starting at base of directory tree
  66.    (thus, own htaccess file is favored */
  67.  
  68.   do while (rest \= '')
  69.     restdoggy=right(rest,1)
  70.     parse var rest _dir'/'rest
  71.     if (right( _dir,1) == ':') then PathTo = _dir
  72.     else PathTo = PathTo'/'_dir
  73.  
  74.     if dodirs==3 then do;
  75.           if upper(pathto) \= owndir then do
  76.                 iterate
  77.           end
  78.     end
  79.  
  80.     goofy=rest ; if goofy=' ' & restdoggy='/' then goofy='/'
  81.     if (left(PathTo,3) == '///') then 
  82.            PathTo = substr(PathTo,2)
  83.     else if (goofy \= '')  & (right( _dir,1) \= ':') then do
  84.          geek1=pathto'/'accessfilename
  85.          ACLfile = stream(geek1, 'c', 'query exists')
  86.  
  87.  
  88.       if (ACLfile \= '') then do /* if not, climb up the tree */
  89.          gotlist=gotlist' 'aclfile
  90.          Auth.GroupFile = ' '
  91.          Auth.Limit = ' '
  92.          rc = stream( ACLfile, 'c', 'OPEN READ')
  93.          line = linein( ACLfile, 1)
  94.          do while (line \= '')
  95.             do while( pos(left(line,1), "2009"x) > 0); line = substr(line, 2); end
  96.             if ( pos(left(line,1), "#") > 0) then line = substr(line, 2)
  97.             if ( left(line,1) == ';') then line = ';COMMENT'
  98.  
  99.             parse var line key ':' val
  100.             val = strip(val)
  101.             key = translate(key)
  102.             if (key = 'AUTHUSERFILE') | (key = 'AUTHGROUPFILE') | (key = 'REDIRLIST') then do
  103.                if (pos(':', val ) == 0) then do
  104.                   val = translate(val, '\', '/')
  105.                   if (left(val,1) == '\') then val = substr( val, 2)
  106.                   val = dir || val
  107.                end
  108.             end
  109.             select
  110.                when (key = 'AUTHNAME') then Auth.Name = val
  111.                when (key = 'AUTHTYPE') then Auth.Type = translate( strip(val))
  112.                when (key = 'AUTHUSERFILE') then Auth.UserFile = val
  113.                when (key = 'AUTHGROUPFILE') then Auth.GroupFile = val
  114.                when (key = 'DEFAULTINDEX') then Auth.Index = val
  115.                when (key = 'REDIRLIST') then RedirectFile = val
  116.                when (key = 'REDIRFILE') then RedirectFile = val  /* bug? in original code */
  117.                when (key = 'LIMIT') then    Auth.Limit = val
  118.                when (key = 'BUILDDIR') then Dir.Build = (val \= '0')
  119.                when (key = 'DIR.EXCLUDE') then Dir.Exclude = Dir.Exclude val
  120.                when (key = '_DIR.EXCLUDE') then Dir.Exclude = val
  121.                when (key = 'DIR.INFO') then Dir.Info = val
  122.                when (key = 'DIR.DESCRIBE') then Dir.Describe = val
  123.                when (key = 'DIR.FORBID') then Dir.Forbid = (val \= '0')
  124.                when (key = 'DIR.BUILDER') then Rx.BuildDir = val
  125.                when (key = 'ENABLEPOSTPROCESS') then do
  126.                      v = left(strip(val),1)
  127.                      if (pos(v, '012') > 0) then Rx.EnablePostProcess = v
  128.                   end
  129.                otherwise 
  130.             end
  131.  
  132.             line = linein( ACLfile)
  133.          end
  134.          rc = stream( ACLfile, 'c', 'close')
  135.  
  136.        end                /* this aclfile */
  137.     end          /* goofy */
  138.   end                       /* climbing up directory tree */
  139.  
  140.  
  141. /*****  if ay files, and not in info gathering mode, then check access, etc privs */
  142.  if auth.type \=' '  & dodirs=0    then do
  143.  
  144. /* check if trying to get htaccess, group, or password file. If so, forbid! */
  145.          parse upper var rest filename     
  146.          ff2=translate(file,'/','\')
  147.          parse upper var Auth.UserFile PassFile         /*password file */
  148.          if translate(PassFile,'/','\') == ff2 then do
  149.                 response('forbid', 'is not allowed')
  150.                EXIT -1
  151.           end  
  152.           parse upper var Auth.GroupFile AuthGroupFile   /* group file */
  153.           ff1=translate(authgroupfile,'/','\')
  154.           if ( ff1 == Ff2) then do
  155.                 response('forbid', 'is not allowed')
  156.                 EXIT -1
  157.           END
  158.           parse upper var AccessFileName _AccessFileName   /* access file */
  159.           flimco=upper(filespec('n', File))
  160.           if ( _AccessFileName == flimco ) then DO
  161.              response('forbid', 'is not allowed')
  162.              EXIT -1
  163.           END
  164.            
  165.  /* NOT a disallowed file: so fill in missing info */
  166.          if clientport="" then clientport=extract('clientport')
  167.          if port=""  then port=extract('serverport')
  168.          if dir="" then dir=datadir()
  169.          if servername="" then servername=servername()
  170.  
  171.          if auth.limit \=' ' then do            /* augment allowed users set */
  172.             parse var Auth.Limit AuthLimitKey _rest
  173.             AuthLimitKey = translate( AuthLimitKey)
  174.             select
  175.               when (AuthLimitKey == 'REQUIRE') then do 
  176.                    Set = strip(_rest)
  177.                    if (Auth.GroupFile \= '') then do
  178.                         Set = CompleteSet( Set, Auth.GroupFile)
  179.                    end
  180.               end
  181.               when (AuthLimitKey == '') then Set = ''  /* a blank causes a resetting */
  182.               otherwise DO
  183.                   Response('notimpl', 'Auth Limit command ['AuthLimitKey'] not recognized.')
  184.                   EXIT -1
  185.               END
  186.            end
  187.          END                    /* AUTH LIMIT */
  188.  
  189.          retCode = Auth.Index ; IF RETCODE=' ' THEN RETCODE=0
  190.  
  191.  
  192.          Auth_Type = Auth.Type
  193.          select
  194.               when (Auth_Type == 'BASIC') then do
  195. /* Do not allow access to user password file, if requested.  */
  196.                   parse upper var rest filename
  197.                   parse upper var Auth.UserFile PassFile
  198.                   if ( upper(translate(PassFile,'/','\')) == upper(translate(File,'/','\'))) then do
  199.                      response('forbid', 'is not allowed')
  200.                      EXIT -1
  201.                   end  /* Do */
  202.                   call authorize Auth.Name, Set
  203.                   Secured = '0'    
  204.               end
  205.  
  206. /*  Code to allow restriction to a specific account or machine, */
  207. /*    without any challenge.      */
  208.               when (Auth_Type == 'IDENT') then do
  209.                  Secured = '0'    
  210.  
  211. /* IDENT client code  */
  212.                  if name=0 | name='' then
  213.                     name = ClientName()
  214.  
  215. /* Create a short list of possible machine identity matches... */
  216.                  _Set = ' '
  217.                  do i = 1 to words(Set)
  218.                     if (pos(name, word(Set,i)) > 0) then _Set = _Set' 'Word(Set,i)
  219.                     else do
  220.                        rest = word(Set,i)
  221.                        parse var rest id'@'rest
  222.                        if ( left(rest,1) == '*') then do
  223.                           cp = translate(substr(rest,2))
  224.                           if ( cp == translate(right( name, length(cp)))) then _Set = _Set' 'Word(Set,i)
  225.                        end
  226.                     end
  227.                  end
  228. /*  If short list is empty, then we can bypass, as request will be failed..  */
  229.                  if (words(_Set) == 0) then Set = ''
  230.  
  231. /* else, if no wildcard userids in short list to eliminate the need to do user identity check.... */
  232.                  else if (pos('*@', _Set) == 0) then do
  233.                     if (RxFuncQuery("SockSocket")) then do 
  234.                        rc = RxFuncAdd("SockLoadFuncs","RxSock","SockLoadFuncs")
  235.                        rc = SockLoadFuncs()
  236.                     end
  237.  
  238.                     Ident = SockSocket('AF_INET','SOCK_STREAM',0)
  239.                     addr.family = 'AF_INET'
  240.                     if who="" then who=extract('clientaddr')
  241.                     addr.addr = who
  242.                     addr.port = 113
  243.                     rc = SockConnect(Ident,'addr.')
  244.                     if rc = 0 Then do
  245.                        len = SockSend(Ident,clientport','port'0d0a'x)
  246.                        len = SockRecv(Ident,'data',256)
  247.                        rc = SockClose(Ident)
  248.                        parse var data port1 ',' port2 ':' 'USERID:' OS ':' data
  249.                        data = translate(data,'','0d0a'x)
  250.                        data = strip(data)
  251.                        data = translate(data,'_',' ')
  252.                     end
  253.                     else do
  254.                        rc = SockClose(Ident)
  255.                        data = ''
  256.                     end
  257.                  end
  258.                  else data = ''
  259.  
  260.                  username = data'@'name
  261.  
  262.                  Set = strip(_Set)
  263.                  do i = 1 to words(Set)
  264.                     _check = word(Set, i)
  265.                     parse var _check first'@'rest
  266.  
  267.         /* check user identity info... */
  268.                     if (first == '*') then first = data
  269.  
  270.         /* Check machine identity part... */
  271.                     if (rest == '*') then rest = name
  272.                     else if ( left(rest,1) == '*') then do
  273.                        cp = translate(substr(rest,2))
  274.                        if ( cp == translate(right( name, length(cp)))) then rest = name
  275.                     end
  276.  
  277.                     _check = first'@'rest
  278.                     if (username == _check) then do
  279.                         signal gohome9
  280.                     end
  281.                  end
  282.                  Response('forbid', 'could not be honored...')
  283.                  EXIT -1
  284.               end                       /* IDENT check */
  285.               when (Auth_Type == '') then do
  286.               end
  287.               otherwise DO
  288.                    response('notimpl', 'referenced an unsupported authentication method')
  289.                    EXIT -1
  290.               END
  291.          end                    /* ident, basic, etc. if */
  292.   end 
  293.  
  294.  if dodirs=1 then  do     /* to return list of DIR.xx variables */
  295.               return dir.build ',' DIR.exclude ',' dir.info ',' dir.describe ',' dir.forbid ',' rx.builddir
  296.  end
  297.  
  298.  if dodirs>1 then do
  299.            bigone=gotlist', 'auth.name', 'auth.type', 'auth.userfile', 'auth.groupfile
  300.            bigone=bigone', 'auth.index', 'redirectfile', 'auth.limit', 'dir.build
  301.            bigone=bigone', 'dir.exclude', 'dir.info', 'dir.describe', 'dir.forbid', 'rx.builddir
  302.            bigone=bigone', 'rx.enablepostprocess
  303.            return bigone
  304. end
  305.  
  306.  
  307. gohome9: nop
  308. /* check for redirection */
  309.   foo=doredirect(redirectfile,file) /* if redirect, exit */
  310.  
  311. /* see if suppress postfilter */
  312.     nopostf=rx.enablepostprocess ; nopostfilter=0
  313.     if nopostf \=' ' then do
  314.              atype=sref_mediatype(file)
  315.              select
  316.                   when nopostf=0 then
  317.                         nopostfilter=1
  318.                   when nopostf=1 & upper(atype)\='TEXT/HTML' then
  319.                         nopostfilter=1
  320.                   when nopostf=2 then do
  321.                     FOO1=LASTPOS('.',file) ; anext=' '
  322.                     if foo1>0 then anext=upper(delstr(file,1,foo1))
  323.                     IF ABBREV(anext,'SHT')=0 then nopostfilter=1
  324.                   end
  325.                   otherwise
  326.                         nop
  327.             end
  328.   end
  329.  
  330.  
  331.   return  secured ',' retCode ',' nopostfilter 
  332.  
  333.  
  334. /* ----------------------------------------------------------------------- */
  335. /* AUTHORIZE -- check access to data is authorized                         */
  336. /* ----------------------------------------------------------------------- */
  337. /* This routine exits directly if it needs to challenge the client, so it  */
  338. /* must be internal.  If authorization is valid, it returns to caller.     */
  339. /* Argument is the Realm to which the data belongs (this tells the user    */
  340. /* which userid/password pair to use.                                      */
  341. /* In this sample filter, the password must be the userid; in a real       */
  342. /* application, it would probably be held in a file (such as a .INI file). */
  343. authorize: procedure expose    who name  clientport   PassFile SERVERNAME TEMPFILE port
  344.  
  345.  
  346.   Set=strip(arg(2))
  347.  
  348.   afield=reqfield('Authorization')      /* see if incoming authorization */
  349.   parse var afield . m64 .              /* get the encoded cookie */
  350.   dec=pack64(m64)                       /* and decode it */
  351.   parse var dec user ':' pw             /* split to userid and password */
  352.   /* [password checking code] */
  353.   if (CheckPW( user, pw, PassFile, Set)) then return
  354.   /* [End of password checking code] */
  355.   realm=strip(arg(1))
  356.   'header add WWW-Authenticate: Basic Realm=<'realm'>'  /* challenge */
  357.    response('unauth', "for realm '"realm"' was not authorized")
  358.    EXIT -1
  359.  
  360.  
  361. /* ----------------------------------------------------------------------- */
  362. /* CHECKPW -- Check if Password is correct for specified user.     */
  363. /* ----------------------------------------------------------------------- */
  364. CheckPW: procedure expose clientport SERVERNAME TEMPFILE port
  365.    parse arg user, pw, PassFile, Set
  366.    rc = (Set == '')        /* set the default - if no SET defined, assume user OK.  */
  367.    do i = 1 to words(Set) 
  368.       if (word(Set,i) == user) then rc = 1
  369.    end
  370.    if (rc) then do
  371.       rc = stream( PassFile, 'C', 'OPEN READ')
  372.       line = linein( PassFile, 1)
  373.       parse var line _user':'_pw
  374.       do while (user \= '') & (user \= _user) & (line \= '')
  375.          line = linein( PassFile)
  376.          parse var line _user':'_pw
  377.       end
  378.       rc = stream( PassFile, 'c', 'close')
  379.       if (line \= '') & (user == _user) then return ( pw == _pw)
  380.    end
  381.    return (0)
  382.  
  383.  
  384. /* ----------------------------------------------------------------------- */
  385. /* COMPLETESET: Fill out the set of users with names from any included groups. */
  386. /* ----------------------------------------------------------------------- */
  387. CompleteSet: procedure EXPOSE SERVERNAME TEMPFILE port
  388.   NewSet = ''
  389.   parse arg Set, AuthGroupFile
  390.   if (AuthGroupFile == '') | (stream( AuthGroupFile, 'c', 'query exists') == '') then return Set
  391.   rc = stream( AuthGroupFile, 'C', 'OPEN READ')
  392.   do i = 1 to Words(Set)
  393.     rc =0
  394.     key = word(set,i)
  395.     line = linein(AuthGroupFile,1)
  396.     do while (rc == 0) & (line \= '')
  397.        parse var line GroupName':'Group
  398.        Group = strip(Group)
  399.        if (GroupName == key) then do
  400.           rc = 1
  401.           NewSet = Newset Group
  402.        end
  403.        line = linein(AuthGroupFile)
  404.     end
  405.     if (rc ==0) then NewSet = NewSet key
  406.   end
  407.   rc = stream( AuthGroupFile, 'c', 'close')
  408.   return strip(NewSet)
  409.  
  410. /* ----------------------------------------------------------------------- */
  411. /* RESPONSE: Standard [mostly error] responses.                            */
  412. /* ----------------------------------------------------------------------- */
  413. /* This routine should stay in the main filter program.                    */
  414. /* Arguments are: response type and extended message information.          */
  415. /* It returns the GoServe command to handle the result file.               */
  416. response: procedure expose tempfile  servername port
  417.   parse arg request, message
  418.  
  419.   select
  420.     when request='badreq'   then use='400 Bad request syntax'
  421.     when request='notfound' then use='404 Not found'
  422.     when request='forbid'   then use='403 Forbidden'
  423.     when request='unauth'   then use='401 Unauthorized'
  424.     when request='notallowed' then use='405 Method not allowed'
  425.     when (request=='moved_p')  then use='301 Moved'
  426.     when (request=='moved_p2')  then use='200 OK'
  427.     when request='notimplemented' then use='501 Not implemented'
  428.     when (request=='notimpl')   then use='501 Not implemented'
  429.  
  430.     otherwise do
  431.         use='406 Not acceptable'
  432.         call pmprintf_sref('weird response '|| request||' '|| message)
  433.       end
  434.     end  /* Add others to this list as needed */
  435.  
  436.    select
  437.    when (request='redirect') | (request='moved_p') then do
  438.           parse var message method ':' rest
  439.           method = method':'
  440.           if (rest == '') | (pos('/', method) > 0) | (pos('\', method) > 0)then do
  441.              method = 'http:'
  442.           end
  443.           else message = rest
  444.           if (left(message,2) \= '//') then do
  445.              saddr = '//'ServerName
  446.              if (port \= 80) then saddr = saddr':'port
  447.           end
  448.           else saddr = ''
  449.           if (left(message,1) \= '/') then message = '/'message
  450.           message = method || saddr || message
  451.           'HEADER ADD URI: 'message
  452.           'HEADER ADD Location: 'message
  453.           doc = '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  454.         end
  455.      when (request='moved_p2') then do
  456.           doc =      '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'crlf,
  457.         "<html><head><title>URI has moved</title></head>"crlf,
  458.         "<body>"crlf,
  459.         message||crlf,
  460.         "<hr><em>HTTP response code:</em>" code crlf,
  461.         "<br><em>From server at:</em>" servername() crlf,
  462.         "</body></html>"
  463.         end
  464.  
  465.     otherwise
  466.         nop
  467.     end
  468.   /* Now set the response and build the response file */
  469.   'RESPONSE HTTP/1.0' use     /* Set HTTP response line */
  470.   parse var use code text
  471.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  472.   call lineout tempfile, "<html><head><title>"text"</title></head>"
  473.   call lineout tempfile, "<body><h2>Sorry...</h2>"
  474.   call lineout tempfile, "<p>The request from your Web client: " message"."
  475.   call lineout tempfile, "<hr><em>HTTP response code:</em>" code '['text']'
  476.   call lineout tempfile, "<br><em>From web server at:</em>" servername
  477.   call lineout tempfile, "<br><em>Running:</em>" server() ', ' sref_version()
  478.   call lineout tempfile, "</body></html>"
  479.   call lineout tempfile  /* close */
  480.   'FILE ERASE TYPE text/html NAME' tempfile
  481.   EXIT -1
  482.  
  483.  
  484. /* ----------------------------------------------------------------------- */
  485. /* DOREDIRECT: do redirect for the URL if in dB, and logging */
  486. /* ----------------------------------------------------------------------- */
  487.  
  488. DoRedirect: procedure  expose sel servername port
  489.       parse arg RedirFile, RequestedFile
  490.       OK = 0
  491.       Case = 1
  492.  
  493.       if (stream(RedirFile, 'c', 'query exists') \= '') then do
  494.          rc = stream( RedirFile, 'C', 'OPEN READ')
  495.          if (rc == 'READY:') then do until ((lines( RedirFile) == 0) | (OK))
  496.             WildCard = 0
  497.             do until (left(text,1) \= '!')
  498.                text = linein(RedirFile)
  499.                if (left(text,1) == '!') then do 
  500.                   if (translate( substr(text,2,14)) == 'CASE SENSITIVE') then Case = 0
  501.                end
  502.             end
  503.             parse var text old_sel':'new_sel rest
  504.             old_sel = strip(old_sel)
  505.             new_sel = strip(new_sel)
  506.             if (left(old_sel,1) == '/') then old_sel = substr( old_sel, 2)
  507.             if (pos('*', old_sel) > 0) then do
  508.                WildCard = 1
  509.                old_sel = left( old_sel, pos('*', old_sel)-1)
  510.                compare = left(sel, length(old_sel))
  511.             end
  512.             else compare = sel
  513.  
  514.             if (Case) then do
  515.                 Compare = translate( Compare)
  516.                 old_sel = translate(old_sel)
  517.             end
  518.  
  519.             if (compare == old_sel) then do
  520.                if (left(new_sel,5) == 'http:') then new_sel = substr(new_sel,6)
  521.                if (pos('*', new_sel) > 0) then do
  522.                   new_sel = left( new_sel, pos('*', new_sel)-1)
  523.                   if (WildCard) then new_sel = new_sel || substr( sel, length(old_sel)+1)
  524.                end
  525.                OK = 1
  526.             end
  527.          end
  528.          rc = stream(RedirFile, 'c', 'close')
  529.       end
  530.  
  531.       if (OK=1) then do
  532.          
  533.          if (pos( 'NOTIFY', translate(rest)) > 0) then do
  534.             crlf = '0d0a'x
  535.             doc =     '<h2>This Resource has been Relocated.</h2>'crlf,
  536.         '<hr size=4>The file "'sel'" has been moved to:'crlf,
  537.         '"<A HREF="http:'new_sel'">http:'new_sel'</A>".<p>'crlf,
  538.         'Please make a note of the new URI, and update any references you can.<p>'
  539.              response('moved_p2', doc)
  540.              EXIT -1
  541.          end
  542.          else DO
  543.             response('moved_p', 'http:'new_sel)
  544.              EXIT -1
  545.          END
  546.       end
  547.  
  548.      return 0
  549.  
  550.