home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Spezial / SPEZIAL2_97.zip / SPEZIAL2_97.iso / ANWEND / ONLINE / SREFPRC1 / DOCGI.SRF < prev    next >
Text File  |  1997-07-13  |  15KB  |  379 lines
  1. /* This is don meyers cgi handler, modified for SRE-FILTER */
  2. /* ----------------------------------------------------------------------- */
  3. /* DoCGI: Handle branching of CGI scripts / subroutines.            */
  4. /* ----------------------------------------------------------------------- */
  5. sref_DoCGI:
  6.  
  7. parse arg cgi_bin_dir, sel, verb, clientname0, filter_name, port ,,
  8.           servername, protocol, dir, who,tempfile,cmdfile,httpd_inc, ,
  9.           VERBOSE,morestuff,do_htaccess,htaccess_file,privset,empty_path_ok,basedir
  10.  
  11.          parse var morestuff enmadd transaction homedir  host_nickname ','fix_expire
  12.          if datatype(fix_expire)<>'NUM' then fix_expire=0
  13.  
  14. /* 
  15.  
  16. 1) cgi_bin_dir is of form d:\goserv\progs (dir where progs located --
  17.   strip final \).  Should be set by configurator.
  18.     Note: cgi-bin\mapimage request strings are captured by SRE-FILTER, and not processed here
  19.  
  20. 2) Sel is parsed, with scriptname, pathparms and list removed:
  21.     i.e.; if sel = cgi-bin/turkey/joe/proj1?arg1=wow
  22.  
  23.   scriptname= turkey  
  24.       This will run  cgi_bin_dir\turkey (a cmd or exe file).
  25.        If you want to run programs NOT in the cgi_bin_dir directory,
  26.  
  27.   pathparms= joe/proj
  28.   list= arg1=wow
  29.  
  30. 3) Other variables are generic variables set in sre-filter
  31.  
  32. */
  33.  
  34.  
  35. parse var sel  t1 '?' list
  36.  
  37.  
  38. foo1=translate(sel,'/','\')
  39. parse var t1 foocgi '/' scriptname '/' pathparms
  40.  
  41. scriptname=strip(scriptname); cgi_bin_dir=strip(cgi_bin_dir)
  42. scriptname=strip(scriptname,,'"')
  43. scriptname=strip(scriptname,,"'")
  44.  
  45. /* see if we should use a different interpeter (i.e.; perl) */
  46. /* check "call" type, using extention of scriptname */
  47. parse upper var scriptname  foo '.' aext ; aext=strip(aext)
  48.  
  49. calltype='CALL '
  50. if aext<>' ' & aext<>'.CMD' & aext<>'.80' then do   /* not a rexx extension -- check others */
  51.    checktypes=upper(value(enmadd||'INTERPRET_TYPES',,'os2environment'))
  52.    foo=strip(pos(aext||'=',checktypes))
  53.    if foo>0 then do
  54.         foo2=pos(' ',checktypes,foo)
  55.         if foo2=0 then foo2=length(checktypes)+1
  56.         wow=substr(checktypes,foo,foo2-foo)
  57.         parse var wow . '=' calltype
  58.         calltype=strip(calltype)||' '
  59.   end
  60. end
  61.  
  62.  
  63. IF VERBOSE>1 THEN call pmprintf_sref(calltype " CGI-Bin call for " scriptname  " , SEL = " SEL)
  64. /* begin  meyer stuff */
  65.   scriptalias=strip(cgi_bin_dir,'t','\')
  66.   env='OS2ENVIRONMENT'
  67. tempfile=translate(tempfile,'\','/')
  68.  
  69.  
  70.   if (verb == 'POST') then do
  71.          'read body var postedlist'                    /* get the incoming data */
  72.          if rc=-4 then                            /* body too large */
  73.            return response_dc('badreq', 'sent too much data')
  74.          if rc<>0 then                            /* e.g., invalid HTTP header */
  75.            return response_dc('badreq', 'sent data that could not be read')
  76.   end
  77.  
  78.   ScriptName = translate(ScriptName)
  79.  
  80. /* we could check by extenstion (com, cmd, exe), but this might cause incorrect errors
  81.    So, we'll risk ugly errors below */
  82.  
  83.   if do_htaccess=1 then do   /* first check htaccess ? */
  84.       foo1=scriptalias'\'scriptname
  85.       tmp1=sref_htaccess(sel,foo1,htaccess_file,who,clientname0,,port,dir, ,
  86.                SERVERNAME,TEMPFILE,0)
  87.        if tmp1=-1 then
  88.            return '401 0'
  89.   end
  90.  
  91.   aa=sysfiletree(scriptalias'\'scriptname,'yow1','F')
  92.  
  93.  
  94.  
  95.   if yow1.1 =0  then
  96.        return response_dc( 'notfound', 'cannot be honored.  <p>This server does not currently support any CGI service called "'ScriptName'".')
  97.   
  98.  
  99. /* else, do the script */
  100.    parse var ScriptAlias Drive':'Rest
  101.    if (Drive == ScriptAlias) then Drive = ''  /* means no drive info to parse off... */
  102.      i = 1
  103.     _acc = REQFIELD("accept")
  104.      acc = '%'
  105.     ClientAccepts = ''
  106.     do while (acc \= _acc)
  107.                acc = REQFIELD("accept", i)
  108.                if (ClientAccepts \= '') then ClientAccepts = ClientAccepts','acc
  109.                else ClientAccepts = acc
  110.                i = i+1
  111.    end
  112.  
  113.    rc = 0
  114.  
  115.   rc = stream(tempfile, 'c', 'close')   /* Close the file to avoid preventing process from access. */
  116.  
  117. /* This is pretty touchy stuff below, be very careful if you edit any of this... */
  118.     InputFile = translate( tempfile, '#', '$')
  119.     ReturnCode = '200'        /* default return code  */
  120.     call lineout CmdFile, "/**/"
  121.     call lineout CmdFile, "'@ECHO OFF'"
  122.     if (Drive \= '') then call lineout CmdFile, "'"Drive":'"
  123.     call lineout CmdFile, "'CD "ScriptAlias"'"
  124.     call lineout CmdFile, "env  = '"env"'"
  125.  
  126.    SrvVersionText = server('H')||' '||filter_name
  127.    rc = value('SERVER_SOFTWARE', SrvVersionText, env)
  128.    rc = value('GATEWAY_INTERFACE','CGI/1.1',env)
  129.    rc = value('SERVER_NAME',ServerName,env)
  130.    rc = value('SERVER_PORT',port,env)
  131.  
  132.    i =1
  133.    l =1
  134.    ClientAccepts = ''
  135.  
  136.    HeaderFile = translate( tempfile, '~', '$')
  137.    'READ HEADER FILE NAME 'HeaderFile                    /* get the incoming header data */
  138.     hd = linein( HeaderFile, 1)
  139.     do while (hd \= '')
  140.          hd = linein( HeaderFile)
  141.          parse var hd Hkey': 'content
  142.          Hkey = translate(Hkey, '_', '-')
  143.          Hkey = translate(Hkey)
  144.          select
  145.              when (Hkey == 'ACCEPT') then do
  146.                     parse var content content'; 'q
  147.                     if (i > 1) then ClientAccepts = ClientAccepts', 'content
  148.                     else ClientAccepts = content
  149.                     if (l == 5) then do
  150.                        call lineout CmdFile, "'SET HTTP_ACCEPT=%HTTP_ACCEPT%"ClientAccepts"'"
  151.                        ClientAccepts = ''
  152.                        l = 1
  153.                     end
  154.                     l = l+1
  155.                     i = i+1
  156.              end   /* accept */
  157.  
  158. /* Handle other, unrecognized headers to conform to CGI/1.1 spec.  */
  159.               otherwise do
  160.                      if (Hkey \= '') then rc = lineout(CmdFile, "rc = value('HTTP_"Hkey"','"content"',env)")
  161.               end
  162.           end     /*select */
  163.     end
  164.  
  165.     rc = lineout( HeaderFile)
  166.     if (ClientAccepts \= '') then call lineout CmdFile, "'SET HTTP_ACCEPT=%HTTP_ACCEPT%"ClientAccepts"'"
  167.  
  168.     crlf = '0d0a'x
  169.     if empty_path_ok=1 & strip(pathparms)='' then do
  170.              pathparms='' ; tt1=''
  171.     end
  172.     else do
  173.        if pathparms<>" " then
  174.              tt1=sref_do_virtual(dir,pathparms,enmadd,0,transaction,homedir,host_nickname)
  175.         else
  176.            tt1=dir
  177.         tt1=translate(tt1,'/','\')
  178.         pathparms='/'||strip(translate(pathparms,'/','\'),'l','/')
  179.    end
  180.    pathparms=upper(pathparms) ; tt1=upper(tt1)
  181.    if empty_path_ok=1 then
  182.       scn='/CGI-BIN/'||scriptname
  183.     else
  184.         scn=scriptname
  185.  
  186.  
  187.    remuser=' '
  188.    authtype=' '
  189.    goo=reqfield('AUTHORIZATION:')
  190.    if goo<>" " then do
  191.       parse var goo authtype m64 .              /* get the encoded cookie */
  192.       dec=pack64(m64)                       /* and decode it */
  193.       parse upper var dec remuser ':' .      /* split to userid and password */
  194.    end
  195.  
  196.  
  197. /* fixed auth_Type and remote_user, 1/97)
  198.    added sref_privest, 2/97  */
  199.     mytid=dostid();mypid=dospid()
  200. /* note that script_dir and caller_thread are sre-filter addons */
  201.     output_text =     "rc = value('SCRIPT_NAME','"ScN"',env)"crlf,
  202.     "rc = value('REQUEST_METHOD','"verb"',env)"crlf,
  203.     "rc = value('SREF_PRIVSET','"privset"',env)"crlf,
  204.     "rc = value('REMOTE_ADDR','"who"',env)"crlf,
  205.     "rc = value('SERVER_ROOT','"basedir"',env)"crlf,
  206.     "rc = value('SERVER_PROTOCOL','"protocol"',env)"crlf,
  207.     "rc = value('PATH_INFO','"PathParms"',env)"crlf,
  208.     "rc = value('PATH_TRANSLATED','"tt1"',env)"crlf,
  209.      "rc = value('REMOTE_USER','"||remuser||"',env)"crlf,
  210.      "rc = value('AUTH_TYPE','"||authtype||"',env)"crlf,
  211.      "rc = value('CONTENT_TYPE','"REQFIELD("Content-type")"',env)"crlf,
  212.      "rc = value('CONTENT_LENGTH','"REQFIELD("Content-length")"',env)"crlf,
  213.      "rc = value('REMOTE_HOST','"clientname0"',env)"crlf,
  214.      "rc = value('QUERY_STRING','"list"',env)"crlf,
  215.      "rc = value('CALLER_THREAD','"mytid"',env)"crlf,
  216.      "rc = value('SERVER_PID','"mypid"',env)"crlf,
  217.      "rc = value('SCRIPT_DIR','"upper(scriptalias)"',env)"
  218.  
  219.  
  220.     call lineout CmdFile, output_text
  221.  
  222.     /* Change suggested by someone (lost the email) to allow 4OS2 to be used as shell.   */
  223.      ScriptAlias = translate( ScriptAlias, '\', '/')
  224.  
  225.      plist=packur(list)                /* pack escape sequences in list */
  226.  
  227.      if (plist \= '') then DO
  228.                if (pos('&', plist) > 0) | (pos('=', plist) > 0) | (pos("'", plist) > 0) then 
  229.                   plist = ''        /*  simply omit the parameter list in this case.        */
  230.                else do            /* Process the parameter list back to original ascii format */
  231.                   plist = translate( plist, ' ', '+')
  232.                end
  233.      END
  234.      if (verb == 'POST') then do 
  235.                rc = charout( InputFile, postedlist, 1)
  236.                rc = stream( InputFile, 'C', 'close')        /* Close file */
  237.                call lineout CmdFile, "'" calltype ScriptAlias"\"ScriptName" "plist" <"InputFile" >>"tempfile"'"
  238.  
  239.      end
  240.      else do 
  241.             call lineout CmdFile, "'" CALLtype ScriptAlias"\"ScriptName" "plist" >>"tempfile"'" 
  242.  
  243.      end
  244.  
  245. /* dmh addition: if called from a #exec=xxx?yyy HTTPD style server side
  246. include, then just return contents of tempfile as is */
  247.      if httpd_inc=1 then do
  248.         call lineout tempfile ; call lineout cmdfile
  249.         ab=rxqueue('s','SESSION')
  250.         RCODE=-1
  251.         address cmd 
  252.         CmdFile
  253.         rcode=RC
  254.         address
  255.         YIKEs=' '
  256.         if (rcode == 0) then do
  257.              yikes=charin(tempfile,1,chars(tempfile))
  258.         end
  259.         A=STREAM(TEMPFILE,'C','CLOSE')
  260.         rc = SysFileDelete( tempfile)
  261.         rc = SysFileDelete( CmdFile)       
  262.         rc = SysFileDelete( HeaderFile)    
  263.  
  264.         RETURN YIKES
  265.      end
  266.  
  267.      call lineout CmdFile        /* Close file */
  268.      do 
  269.           address cmd
  270.           CmdFile
  271.           rcode=RC
  272.           address
  273.           bunko=stream(tempfile,'c','query size')
  274.           if bunko=' ' | bunko=0 then rcode='Problem with script: 'scriptname
  275.  
  276.           if (rcode == 0) then do
  277.              Hder = '%'
  278.              ContentType = 'text/html'
  279.              ContentLength = 0
  280.              do while (Hder \= '')
  281.                 Hder = linein( tempfile) 
  282.                 if hder="" then iterate
  283.  
  284.                 parse var Hder Hkey': 'content
  285.                 _Hkey = Hkey
  286.                 _Hkey = translate( _Hkey)
  287.  
  288. /* This should handle the special header case of nph-* scripts... */
  289.                 if (word(_Hkey,1) == 'HTTP/1.0') then do
  290.                         parse var Hder Hkey content
  291.                         _Hkey = 'STATUS'
  292.                       'HEADER NOAUTO'
  293.                  end
  294.  
  295.                  select
  296.                         when (_Hkey == 'CONTENT-LENGTH') then ContentLength = content
  297.                         when (_Hkey == 'CONTENT-TYPE') then ContentType = content
  298.                         when (_Hkey == 'LOCATION') | (_Hkey == 'URI') then do
  299. /*  It is not 'spec' to assume a redirect if URI is included, but 'LOCATION' isn't really even 'spec'... */
  300.                            if (_Hkey == 'LOCATION') then do
  301.                               ReturnCode = '302'
  302.                              'RESPONSE HTTP/1.0 'ReturnCode' Found'     /* Set HTTP response line */
  303.                            end
  304.                           'HEADER ADD 'Hkey': 'content
  305.                         end
  306.                         when (_Hkey == 'STATUS') then do
  307.                            parse var content ReturnCode rest
  308.                            'RESPONSE HTTP/1.0 'content     /* Set HTTP response line */
  309.                         end
  310.                         otherwise 'HEADER ADD 'Hkey': 'content /* oo */
  311.                     end
  312.                  end
  313.                  _ContentLength = Chars(tempfile)
  314.                  if ( _ContentLength < ContentLength) | (ContentLength == 0) then ContentLength = _ContentLength
  315.  
  316.                  'HEADER ADD Content-length: ' ContentLength
  317.                   Content = charin( tempfile,, ContentLength)
  318.                   Call Lineout tempfile            /* Close file before delete */
  319.                end              /* rcode=0 */
  320.  
  321.                rc = SysFileDelete( tempfile)        /* delete tempfile because we're shortening it.  */
  322.                rc = SysFileDelete( CmdFile)           /* delete CmdFile, we're done with it.  */
  323.                if (verb == 'POST') then rc = SysFileDelete( InputFile)    /* delete InputFile, we're done with it.  */
  324.                rc = SysFileDelete( HeaderFile)    /* delete HeaderFile, we're done with it.  */
  325.  
  326.                if (rcode \= 0) then return response_dc('badreq', 'could not be completed.<p><pre>    Form Error: 'rcode'</pre>')
  327.  
  328.          /*      rc = charout( tempfile, Content, 1) */    /* Write contents back to tempfile  */
  329.           /*     rc = stream( tempfile, 'c', 'close') */
  330.  
  331.                if fix_expire>0 then 
  332.                    foo=sref_expire_response(fix_expire,contentlength,contentTYPE)
  333.  
  334.                'VAR TYPE 'ContentType' AS ' scriptname ' NAME CONTENT '
  335.                return returncode||' '||contentlength
  336.            end          /* rcode=0 */
  337. /*   end*/
  338.  
  339.    return response_dc('badreq', 'problem with CGI script "'scriptname'".')
  340.  
  341.  
  342. /* ----------------------------------------------------------------------- */
  343. /* RESPONSE_dc: Standard [mostly error] responses.                            */
  344. /* ----------------------------------------------------------------------- */
  345. /* This routine should stay in the main filter program.                    */
  346. /* Arguments are: response type and extended message information.          */
  347. /* It returns the GoServe command to handle the result file.               */
  348. response_dc: procedure expose tempfile  seloriginal request0 source0 servername
  349.   parse arg request, message
  350.   select
  351.     when request='badreq'   then use='400 Bad request syntax'
  352.     when request='notfound' then use='404 Not found'
  353.     when request='forbid'   then use='403 Forbidden'
  354.     when request='unauth'   then use='401 Unauthorized'
  355.     otherwise do
  356.         use='404 Not found'
  357.         say 'weird response ' request message
  358.       end
  359.     end  /* Add others to this list as needed */
  360.  
  361.  
  362.   /* Now set the response and build the response file */
  363.   'RESPONSE HTTP/1.0' use     /* Set HTTP response line */
  364.   parse var use code text
  365.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  366.   call lineout tempfile, "<html><head><title>"text"</title></head>"
  367.   call lineout tempfile, "<body><h2>Sorry...</h2>"
  368.   call lineout tempfile, "<p>The request from your Web client" message"."
  369.   call lineout tempfile, "<hr><em>HTTP response code:</em>" code '['text']'
  370.   call lineout tempfile, "<br><em>From server at:</em>" servername
  371.   call lineout tempfile, "<br><em>Running:</em>" server()
  372.   call lineout tempfile, "</body></html>"
  373.   call lineout tempfile  /* close */
  374.   a2=dosdir(tempfile,'s')
  375.   'FILE ERASE TYPE text/html NAME' tempfile
  376.   a1=word(use,1)
  377.   return a1||' '||a2
  378.  
  379.