home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Spezial / SPEZIAL2_97.zip / SPEZIAL2_97.iso / ANWEND / ONLINE / SREFPRC1 / DOCGI3.SRF < prev    next >
Text File  |  1997-07-13  |  17KB  |  467 lines
  1. /* SREF_DOCGI_PIECES_2:
  2.  This is used when cgi_bin_pieces=2 -- send cgi-bin output "as it's written",
  3.  fileread mode (as opposed to named pipe mode).
  4.     This is a VERY heavily modified version of
  5.     don meyers cgi handler.  The biggest change is the use of pipes
  6.     to capture stdout -- which allows sending output as recived.
  7. */
  8. sref_DoCGI_pieces_2:
  9.  
  10. parse arg cgi_bin_dir, sel, verb, clientname0, filter_name, port ,,
  11.           servername, protocol, dir, who,tempfile,cmdfile,httpd_inc, ,
  12.           VERBOSE,morestuff,do_htaccess,htaccess_file,privset,empty_path_ok,basedir
  13.  
  14. if rxfuncquery('fileread_rxf')=1 then do
  15.    goti1=RxFuncAdd('Fileread_rxf', 'FILEREXX', 'fileread')
  16.    if goti1=1 then call pmprintf(" Error: unable to load FILEREAD FILEREXX functions; using named pipe mode ")
  17.  end
  18. if rxfuncquery('fileopen_rxf')=1 then do
  19.      goti2=RxFuncAdd('Fileopen_rxf', 'FILEREXX', 'fileopen')
  20.     if goti2=1 then call pmprintf(" Error: unable to load FILEOPEN FILEREXX functions; using named pipe mode ")
  21. end
  22. if rxfuncquery('fileclose_rxf')=1 then do
  23.    goti3=RxFuncAdd('Fileclose_rxf', 'FILEREXX', 'fileclose')
  24.    if goti3=1 then call pmprintf(" Error: unable to load FILECLOSE FILEREXX function; using named pipe mode ")
  25. end
  26.  
  27. parse var morestuff enmadd transaction homedir  host_nickname ','fix_expire','myqueue', 'mysem
  28.  
  29. myqueue=strip(myqueue) ; mysem=strip(mysem);fix_expire=strip(fix_expire)
  30. if datatype(fix_expire)<>'NUM' then fix_expire=0
  31.  
  32. /* 
  33. 1) cgi_bin_dir is of form d:\goserv\progs (dir where progs located --
  34.   strip final \).  Should be set by configurator.
  35.     Note: cgi-bin\mapimage request strings are captured by SRE-FILTER, and not processed here
  36.  
  37. 2) Sel is parsed, with scriptname, pathparms and list removed:
  38.     i.e.; if sel = cgi-bin/turkey/joe/proj1?arg1=wow
  39.  
  40.   scriptname= turkey  
  41.       This will run  cgi_bin_dir\turkey (a cmd or exe file).
  42.        If you want to run programs NOT in the cgi_bin_dir directory,
  43.  
  44.   pathparms= joe/proj
  45.   list= arg1=wow
  46.  
  47. 3) Other variables are generic variables set in sre-filter
  48.  
  49. */
  50.  
  51.  
  52. parse var sel  t1 '?' list
  53.  
  54.  
  55. foo1=translate(sel,'/','\')
  56. parse var t1 foocgi '/' scriptname '/' pathparms
  57.             
  58. scriptname=strip(scriptname); cgi_bin_dir=strip(cgi_bin_dir)
  59. scriptname=strip(scriptname,,'"')
  60. scriptname=strip(scriptname,,"'")
  61.  
  62. /* see if we should use a different interpeter (i.e.; perl) */
  63. /* check "call" type, using extention of scriptname */
  64. parse upper var scriptname  foo '.' aext ; aext=strip(aext)
  65.  
  66. calltype='CALL '
  67. if aext<>' ' & aext<>'.CMD' & aext<>'.80' then do   /* not a rexx extension -- check others */
  68.    checktypes=upper(value(enmadd||'INTERPRET_TYPES',,'os2environment'))
  69.    foo=strip(pos(aext||'=',checktypes))
  70.    if foo>0 then do
  71.         foo2=pos(' ',checktypes,foo)
  72.         if foo2=0 then foo2=length(checktypes)+1
  73.         wow=substr(checktypes,foo,foo2-foo)
  74.         parse var wow . '=' calltype
  75.         calltype=strip(calltype)||' '
  76.   end
  77. end
  78.  
  79.  
  80. IF VERBOSE>1 THEN call pmprintf_sref(calltype " CGI-Bin call for " scriptname  " , SEL = " SEL)
  81. /* begin  meyer stuff */
  82.   scriptalias=strip(cgi_bin_dir,'t','\')
  83.   env='OS2ENVIRONMENT'
  84. tempfile=translate(tempfile,'\','/')
  85.  
  86.  
  87.   if (verb == 'POST') then do
  88.          'read body var postedlist'                    /* get the incoming data */
  89.          if rc=-4 then                            /* body too large */
  90.            return response_dc('badreq', 'sent too much data')
  91.          if rc<>0 then                            /* e.g., invalid HTTP header */
  92.            return response_dc('badreq', 'sent data that could not be read')
  93.   end
  94.  
  95.   ScriptName = translate(ScriptName)
  96.  
  97. /* we could check by extenstion (com, cmd, exe), but this might cause incorrect errors
  98.    So, we'll risk ugly errors below */
  99.  
  100.   if do_htaccess=1 then do   /* first check htaccess ? */
  101.       foo1=scriptalias'\'scriptname
  102.       tmp1=sref_htaccess(sel,foo1,htaccess_file,who,clientname0,,port,dir, ,
  103.                SERVERNAME,TEMPFILE,0)
  104.        if tmp1=-1 then
  105.            return '401 0'
  106.   end
  107.  
  108.   aa=sysfiletree(scriptalias'\'scriptname,'yow1','F')
  109.  
  110.   if yow1.1 =0  then
  111.        return response_dc( 'notfound', 'cannot be honored.  <p>This server does not currently support any CGI service called "'ScriptName'".')
  112.   
  113. /* else, do the script */
  114.    parse var ScriptAlias Drive':'Rest
  115.    if (Drive == ScriptAlias) then Drive = ''  /* means no drive info to parse off... */
  116.      i = 1
  117.     _acc = REQFIELD("accept")
  118.      acc = '%'
  119.     ClientAccepts = ''
  120.     do while (acc \= _acc)
  121.                acc = REQFIELD("accept", i)
  122.                if (ClientAccepts \= '') then ClientAccepts = ClientAccepts','acc
  123.                else ClientAccepts = acc
  124.                i = i+1
  125.    end
  126.  
  127.    rc = 0
  128.  
  129.   rc = stream(tempfile, 'c', 'close')   /* Close the file to avoid preventing process from access. */
  130.  
  131. /* This is pretty touchy stuff below, be very careful if you edit any of this... */
  132.     InputFile = translate( tempfile, '#', '$')
  133.     ReturnCode = '200'        /* default return code  */
  134.     call lineout CmdFile, "/**/"
  135.     call lineout CmdFile, "'@ECHO OFF'"
  136.     call lineout cmdfile,'myq="'myqueue'"'
  137.     call lineout cmdfile,'mysem="'mysem'"'
  138.  
  139.     if (Drive \= '') then call lineout CmdFile, "'"Drive":'"
  140.     call lineout CmdFile, "'CD "ScriptAlias"'"
  141.     call lineout CmdFile, "env  = '"env"'"
  142.  
  143.    SrvVersionText = server('H')||' '||filter_name
  144.    rc = value('SERVER_SOFTWARE', SrvVersionText, env)
  145.    rc = value('GATEWAY_INTERFACE','CGI/1.1',env)
  146.    rc = value('SERVER_NAME',ServerName,env)
  147.    rc = value('SERVER_PORT',port,env)
  148.  
  149.    i =1
  150.    l =1
  151.    ClientAccepts = ''
  152.  
  153.    HeaderFile = translate( tempfile, '~', '$')
  154.    'READ HEADER FILE NAME 'HeaderFile                    /* get the incoming header data */
  155.     hd = linein( HeaderFile, 1)
  156.     do while (hd \= '')
  157.          hd = linein( HeaderFile)
  158.          parse var hd Hkey': 'content
  159.          Hkey = translate(Hkey, '_', '-')
  160.          Hkey = translate(Hkey)
  161.          select
  162.              when (Hkey == 'ACCEPT') then do
  163.                     parse var content content'; 'q
  164.                     if (i > 1) then ClientAccepts = ClientAccepts', 'content
  165.                     else ClientAccepts = content
  166.                     if (l == 5) then do
  167.                        call lineout CmdFile, "'SET HTTP_ACCEPT=%HTTP_ACCEPT%"ClientAccepts"'"
  168.                        ClientAccepts = ''
  169.                        l = 1
  170.                     end
  171.                     l = l+1
  172.                     i = i+1
  173.              end   /* accept */
  174.  
  175. /* Handle other, unrecognized headers to conform to CGI/1.1 spec.  */
  176.               otherwise do
  177.                      if (Hkey \= '') then rc = lineout(CmdFile, "rc = value('HTTP_"Hkey"','"content"',env)")
  178.               end
  179.           end     /*select */
  180.     end
  181.  
  182.     rc = lineout( HeaderFile)
  183.     if (ClientAccepts \= '') then call lineout CmdFile, "'SET HTTP_ACCEPT=%HTTP_ACCEPT%"ClientAccepts"'"
  184.  
  185.     crlf = '0d0a'x
  186.     if empty_path_ok=1 & strip(pathparms)='' then do
  187.              pathparms='' ; tt1=''
  188.     end
  189.     else do
  190.        if pathparms<>" " then
  191.              tt1=sref_do_virtual(dir,pathparms,enmadd,0,transaction,homedir,host_nickname)
  192.         else
  193.            tt1=dir
  194.         tt1=translate(tt1,'/','\')
  195.         pathparms='/'||strip(translate(pathparms,'/','\'),'l','/')
  196.    end
  197.    pathparms=upper(pathparms) ; tt1=upper(tt1)
  198.    if empty_path_ok=1 then
  199.       scn='/CGI-BIN/'||scriptname
  200.     else
  201.         scn=scriptname
  202.  
  203.  
  204.    remuser=' '
  205.    authtype=' '
  206.    goo=reqfield('AUTHORIZATION:')
  207.    if goo<>" " then do
  208.       parse var goo authtype m64 .              /* get the encoded cookie */
  209.       dec=pack64(m64)                       /* and decode it */
  210.       parse upper var dec remuser ':' .      /* split to userid and password */
  211.    end
  212.  
  213.  
  214. /* fixed auth_Type and remote_user, 1/97)
  215.    added sref_privest, 2/97  */
  216.     mytid=dostid();mypid=dospid()
  217. /* note that script_dir and caller_process caller_thread are sre-filter addons */
  218.     output_text =     "rc = value('SCRIPT_NAME','"ScN"',env)"crlf,
  219.     "rc = value('REQUEST_METHOD','"verb"',env)"crlf,
  220.     "rc = value('SREF_PRIVSET','"privset"',env)"crlf,
  221.     "rc = value('REMOTE_ADDR','"who"',env)"crlf,
  222.     "rc = value('SERVER_ROOT','"basedir"',env)"crlf,
  223.     "rc = value('SERVER_PROTOCOL','"protocol"',env)"crlf,
  224.     "rc = value('PATH_INFO','"PathParms"',env)"crlf,
  225.     "rc = value('PATH_TRANSLATED','"tt1"',env)"crlf,
  226.      "rc = value('REMOTE_USER','"||remuser||"',env)"crlf,
  227.      "rc = value('AUTH_TYPE','"||authtype||"',env)"crlf,
  228.      "rc = value('CONTENT_TYPE','"REQFIELD("Content-type")"',env)"crlf,
  229.      "rc = value('CONTENT_LENGTH','"REQFIELD("Content-length")"',env)"crlf,
  230.      "rc = value('REMOTE_HOST','"clientname0"',env)"crlf,
  231.      "rc = value('QUERY_STRING','"list"',env)"crlf,
  232.      "rc = value('CALLER_THREAD','"mytid"',env)"crlf,
  233.      "rc = value('SERVER_PID','"mypid"',env)"crlf,
  234.      "rc = value('SCRIPT_DIR','"upper(scriptalias)"',env)"
  235.  
  236.  
  237.     call lineout CmdFile, output_text
  238.  
  239. /* Change suggested by someone (lost the email) to allow 4OS2 to be used as shell.   */
  240.      ScriptAlias = translate( ScriptAlias, '\', '/')
  241.  
  242.      plist=packur(list)                /* pack escape sequences in list */
  243.  
  244.      if (plist \= '') then do
  245.                if (pos('&', plist) > 0) | (pos('=', plist) > 0) | (pos("'", plist) > 0) then 
  246.                  /* plist = '"'plist'"'      / *  This line "quotes" the parameter list.  Actual HTTPDs  */ 
  247.                   plist = ''        /*  simply omit the parameter list in this case.        */
  248.  
  249.                else do            /* Process the parameter list back to original ascii format */
  250.                   plist = translate( plist, ' ', '+')
  251.                end
  252.       end
  253.  
  254. /* setup stuff for interprocess communication */
  255.    call lineout cmdfile,"mypid=dospid();mytid=dostid()"
  256.    call lineout cmdfile,"foo=rxqueue('s',myq) "
  257.    call lineout cmdfile,"push mypid  mytid "
  258.    if verbose>3 then
  259.       call lineout cmdfile,' call pmprintf(" (FILEREXX mode) about to call script 'scriptname'")'
  260.   if (verb == 'POST') then do 
  261.                rc = charout( InputFile, postedlist, 1)
  262.                rc = stream( InputFile, 'C', 'close')        /* Close file */
  263.                call lineout CmdFile, "'" calltype ScriptAlias"\"ScriptName" "plist" <"InputFile" >>"tempfile"'"
  264.   end
  265.   else do 
  266.            call lineout CmdFile, "'" CALLtype ScriptAlias"\"ScriptName" "plist" >>"tempfile"'"
  267.   end
  268.   if verbose>3 then call lineout cmdfile,' call pmprintf(" done with script 'scriptname' (" rc)'
  269.  
  270.   call lineout cmdfile,' exit 0'
  271.  
  272.   call lineout CmdFile        /* Close file */
  273.  
  274.  
  275. /* clear queue  */
  276. aa1=-1 ;idid=0 
  277. a=rxqueue('s',myqueue)
  278. do while queued()<>0
  279.    pull .
  280. end
  281.  
  282. /* detach and run the cgi-bin caller */
  283. address cmd
  284.    'DETACH 'CmdFile
  285.    rcode=RC
  286. address 
  287.  
  288. /* get from queue: the process of the detached job */
  289. a=rxqueue('s',myqueue)
  290. do until 1=2
  291.   if queued()=0 then do
  292.      call delay(0.05)
  293.      iterate
  294.   end
  295.   pull chkpid .
  296.   leave
  297. end
  298. if verbose>3 then call pmprintf_sref(" CGI-BIN using process " chkpid)
  299.  
  300. /* ready to read info: with special treatment of the header */
  301. crlf='0d0a'x
  302. pud="" ;nohd=1;sendstart=0 ;handle=0
  303. do until dn=0
  304.   are=readit()   /* use fileread_rxl function to read temporary file */
  305.   if length(are)>0 & nohd=1 then do  /* is there a blank line delimited header */
  306.        pud=pud||are
  307.        pud2=pud ; inpud=0
  308.        do until pud2=""
  309.           parse var pud2 al1 (crlf) pud2
  310.           if al1=""  & length(pud2)>0 then  do    /* blank line, must be end of headers */
  311.               gotem.0=inpud
  312.               aa=do_cgi_header()
  313.               'SEND TYPE ' aa ' AS ' SCRIPTNAME
  314.               'SET NETBUFFER OFF '
  315.               'VAR NAME pud2 '
  316.                nohd=0 ; sendstart=1
  317.               leave
  318.            end                  /* processed header */
  319.            inpud=inpud+1 ; gotem.inpud=al1  /* add to heders list */
  320.        end
  321.    end          /* checking header? */
  322.    else do              /* header's been done, got someting */
  323.        if length(are)>0 then  'VAR NAME ARE '
  324.    end
  325.   if dosprocinfo('s',chkpid)<0 then leave
  326.   call delay(0.02)
  327. end
  328.  
  329. are=readit(1)
  330. if length(are)>0  & nohd=0 then 'VAR NAME ARE'
  331.  
  332. if sendstart=1 then
  333.   'SEND COMPLETE '
  334. else
  335.    return response_dc('badreq', 'problem with CGI script "'scriptname'".')
  336.  
  337. if verbose>3 then do
  338.    cm1=filespec('d',cmdfile)||filespec('p',cmdfile)||'FSMP.CMD'
  339.    oo=sysfiledelete(cm1)
  340.    oo=dosrename(cmdfile,cm1)
  341.    call pmprintf_sref(" Save cgi-bin invoker to " cm1)
  342. end
  343. else do
  344.   rc = SysFileDelete( CmdFile)       /*     delete CmdFile, we're done with it.  */
  345. end
  346. if (verb == 'POST') then rc = SysFileDelete( InputFile)    /* delete InputFile, we're done with it.  */
  347. rc = SysFileDelete( HeaderFile)    /* delete HeaderFile, we're done with it.  */
  348.  
  349. if handle<>0 then aa=fileclose_rxf(handle)
  350. rc = SysFileDelete(tempfile)       
  351.  
  352. return returncode||' '||extract('bytessent')
  353.  
  354.  
  355.  
  356. /********/
  357. /* read from tempfile, using filerexx functions
  358.    Read until you get a null string */
  359. readit:procedure expose handle tempfile
  360. parse arg getall
  361.  
  362. bld=""
  363. if handle=0 then do
  364.     handle=fileopen_rxf(tempfile, 'rs', "e")
  365. end
  366. if handle=0 then return ""
  367. if getall<>1 then do
  368.    addx=fileread_rxf(handle,10000)
  369.   return addx
  370. end
  371.  
  372. do forever
  373.   addx=fileread_rxf(handle,10000)
  374.   if addx="" then return bld
  375.   bld=bld||addx
  376. end
  377.  
  378.  
  379. /***********/
  380. /* routine to deal with header */
  381. do_cgi_header:procedure expose gotem. fix_expire handle
  382.  
  383.   ContentType = 'text/html'
  384.   ContentLength = 0
  385.  
  386.   do ipoop=1 to gotem.0
  387.      Hder = gotem.ipoop
  388.      parse var Hder Hkey': 'content
  389.      _Hkey = Hkey
  390.      _Hkey = translate( _Hkey)
  391.  
  392. /* This should handle the special header case of nph-* scripts... */
  393.     if (word(_Hkey,1) == 'HTTP/1.0') then do
  394.                         parse var Hder Hkey content
  395.                         _Hkey = 'STATUS'
  396.                       'HEADER NOAUTO'
  397.     end
  398.     select
  399.           when (_Hkey == 'CONTENT-LENGTH') then ContentLength = content
  400.           when (_Hkey == 'CONTENT-TYPE') then ContentType = content
  401.           when (_Hkey == 'LOCATION') | (_Hkey == 'URI') then do
  402. /*  It is not 'spec' to assume a redirect if URI is included, but 'LOCATION' isn't really even 'spec'... */
  403.                if (_Hkey == 'LOCATION') then do
  404.                    ReturnCode = '302'
  405.                    'RESPONSE HTTP/1.0 'ReturnCode' Found'     /* Set HTTP response line */
  406.                 end
  407.                'HEADER ADD 'Hkey': 'content
  408.           end
  409.           when (_Hkey == 'STATUS') then do
  410.                            parse var content ReturnCode rest
  411.                            'RESPONSE HTTP/1.0 'content     /* Set HTTP response line */
  412.           end
  413.           otherwise 'HEADER ADD 'Hkey': 'content /* oo */
  414.     end
  415.  end                    /* do loop */
  416.  if contentlength>0 then 'HEADER ADD Content-length: ' ContentLength
  417.  
  418.  if fix_expire>0 then do
  419.        alen=contentlength ; if contentlength=0 then alen=' '
  420.        foo=sref_expire_response(fix_expire,alen,contenttype)
  421.  end
  422.  
  423.  return contenttype
  424.  
  425.  
  426. /* ----------------------------------------------------------------------- */
  427. /* RESPONSE_dc: Standard [mostly error] responses.                            */
  428. /* ----------------------------------------------------------------------- */
  429. /* This routine should stay in the main filter program.                    */
  430. /* Arguments are: response type and extended message information.          */
  431. /* It returns the GoServe command to handle the result file.               */
  432. response_dc: procedure expose tempfile  seloriginal request0 source0 servername
  433.   parse arg request, message
  434.   select
  435.     when request='badreq'   then use='400 Bad request syntax'
  436.     when request='notfound' then use='404 Not found'
  437.     when request='forbid'   then use='403 Forbidden'
  438.     when request='unauth'   then use='401 Unauthorized'
  439.     otherwise do
  440.         use='404 Not found'
  441.         say 'weird response ' request message
  442.       end
  443.     end  /* Add others to this list as needed */
  444.  
  445.  
  446.   /* Now set the response and build the response file */
  447.   'RESPONSE HTTP/1.0' use     /* Set HTTP response line */
  448.   parse var use code text
  449.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  450.   call lineout tempfile, "<html><head><title>"text"</title></head>"
  451.   call lineout tempfile, "<body><h2>Sorry...</h2>"
  452.   call lineout tempfile, "<p>Problem detected:" message"."
  453.   call lineout tempfile, "<hr><em>HTTP response code:</em>" code '['text']'
  454.   call lineout tempfile, "<br><em>From server at:</em>" servername
  455.   call lineout tempfile, "<br><em>Running:</em>" server()
  456.   call lineout tempfile, "</body></html>"
  457.   call lineout tempfile  /* close */
  458.   a2=dosdir(tempfile,'s')
  459.   'FILE ERASE TYPE text/html NAME' tempfile
  460.   a1=word(use,1)
  461.   if handle<>0 then aa=fileclose_rxf(handle)
  462.  
  463.   return a1||' '||a2
  464.  
  465.  
  466.  
  467.