proc CgiSpawn {sock script} {
    upvar #0 Httpd$sock data
    global env Cgi
    ##Nikos:This env var is needed to run php cgi securely, in directories under docroot
    set env(REDIRECT_STATUS) 1

    if {$Cgi(cgi) >= $Cgi(maxcgi)} {
        Httpd_Error $sock 504  "Too many CGI's"
        return
    }
    incr Cgi(cgi)

    # for GET queries, pass the query as an argument to the cgi script
    if {$data(proto) == "POST"} {
        set arglist ""
    } else {
        set arglist $data(query)
    }
    set pwd [pwd]
    cd [file dirname $script]
    if {[catch {CgiExec $script $arglist} fd]} {
        cd $pwd
        Httpd_Error $sock 400 $fd
        incr Cgi(cgi) -1
        return
    }
    cd $pwd
    Count cgihits
    set data(infile) $fd        ;# So close happens in Httpd_SockClose
    set data(header) 0                ;# Have not read header yet
    set data(headerlist) {}        ;# list of read headers
    set data(headercode) "200 data follows"        ;# normal return
    fconfigure $fd -blocking 0

    # Set up a timer in case it hangs

    catch {after cancel $data(cancel)}
    set data(cancel) [after $Cgi(timeout) CgiCancel $fd $sock]

    if {$data(proto) == "POST"} {
        fconfigure $fd -translation binary
        if {$data(count) == 0} {

            # Either there was no POST data, or we are inside a domain
            # that automatically read the POST data into data(query) already
            # Errors appear here because of the non-blocking writes.

            catch {
                puts -nonewline $fd $data(query)
                flush $fd
            }
        } else {

            # Pump the query data to the CGI process in the background
            # We set up fileevents after this finishes, so return now

            # fcopy bug in Tcl 8.3.2 and Tcl 8.4a2 and all previous versions 
            # prevents this from working reliably on large amounts of POST data
            # fcopy $sock $fd -command [list CgiCopyDone $sock $fd] -size $data(count)
            fileevent $sock readable [list CgiCopyPost $sock $fd]
            return
        }
    }

    CgiCopyDone $sock $fd $data(count) ""
 }

 proc CgiClose {fd sock {bytes {}} {error {}}} {
    global Cgi
    upvar #0 Httpd$sock data
    
    catch {after cancel $data(cancel)}
    incr Cgi(cgi) -1
    ##Nikos:This env var was needed to run php cgi securely, now we unset it..
        catch {unset ::env(REDIRECT_STATUS)}
    if {![info exists data(header)]} {
        Httpd_Error $sock 204
    } else {
        Httpd_SockClose $sock 1
    }
    if {[string length $error] > 0} {
        Log $sock CgiClose $error
    }
   
 }

 ###Nikos:Hack to add php cgi capabilities into tclhttpd...

 ##Add the mime types 
 Mtype_Add application/x-php .php
 Mtype_Add application/x-php .php3
 Mtype_Add application/x-php .phtml

 ###Edit this your path, Win used to need full path; now it seems not to
 #set Cgi(php) "c:/php/php.exe"        ;# For .php
 set Cgi(php) "php"                        ;# For .php

 proc Doc_application/x-php {path suffix sock} {
    upvar #0 Httpd$sock data
    Url_Handle [list CgiHandle $data(url) {} $path] $sock
 }

 proc Doc_application/x-php {path suffix sock} {
    upvar #0 Httpd$sock data
    Url_Handle [list CgiHandle $data(url) {} $path] $sock
 }

 puts "PHP CGI Stuff loaded"

 puts {You need to register your php cgi directories with Cgi_Directory}

• There's probably a better point to hook this into the cgi library, but at least this'll get someone started
• If php-dir is outside the docroot (which, I think is a no-no for cgi), and is registered as a virtual directory, then PHP complains of "No Input File"
• the example above can only work under Unix, because Windows needs to be told which interpreter (In this case $Cgi(php) to run over files with .php extensions. There's a three line patch to cgi.tcl, below.

   .php {
      return [open "|[list $Cgi(php) $script] $arglist" r+]
   }

 ##Add the mime types
 Mtype_Add application/x-php .php
 Mtype_Add application/x-php .php3
 Mtype_Add application/x-php .phtml

 ###Edit this your path, Win used to need full path; now it seems not to
 #set Cgi(php) "c:/php/php.exe"        ;# For .php
 set Cgi(php) "php"                        ;# For .php
 lappend Cgi(env-pass) REDIRECT_STATUS

 proc Doc_application/x-php {path suffix sock} {
    upvar #0 Httpd$sock data
    set ::env(REDIRECT_STATUS) 1
    Url_Handle [list CgiHandle $data(url) {} $path] $sock
    unset ::env(REDIRECT_STATUS)
 }

 proc Doc_application/x-php {path suffix sock} {
    upvar #0 Httpd$sock data
    set ::env(REDIRECT_STATUS) 1
    Url_Handle [list CgiHandle $data(url) {} $path] $sock
    unset ::env(REDIRECT_STATUS)
 }

 puts "PHP CGI Stuff loaded"

 puts {You need to register your php cgi directories with Cgi_Directory}

• Download the PHP binaries for windows from http://www.php.net/downloads.php
• Unzip the zip file in c:/php
• Copy the c:/php.ini-recommended file to c:/php/php.ini
• Edit the php.ini file and set the doc_root to your tclhttpd doc_root

• Add the cgi.tcl fix from above to tclhttp/lib/cgi.tcl
• Save the following script to tclhttp/custom/php.tcl

 ##Add the mime types
 Mtype_Add php   application/x-php
 Mtype_Add php3  application/x-php 
 Mtype_Add phtml application/x-php 

 ###Edit this your path, Win used to need full path; now it seems not to
 set Cgi(php) "c:/php/php-cgi.exe"        ;# For .php
 #set Cgi(php) "php"                        ;# For .php
 lappend Cgi(env-pass) REDIRECT_STATUS

 proc Doc_application/x-php {path suffix sock} {
    upvar #0 Httpd$sock data
    set ::env(REDIRECT_STATUS) 1
    Url_Handle [list CgiHandle $data(url) {} $path] $sock
    unset ::env(REDIRECT_STATUS)
 }

 puts "PHP CGI Support loaded"

• Place this example script in tclhttp/htdocs/phptest.php

 <?php
   echo("Hello World");
 ?>

• Start Tclhttpd an point the browser to your the phptest.php file...

 proc CgiExec {script arglist} {
    global tcl_platform
    global Cgi

    set prog ""
    set extn [string trim [file extension $script] "."]
    if { $extn != "cgi" } {
        if { [info exists Cgi($extn)] } { set prog "$Cgi($extn) " }
    }

    switch -- $tcl_platform(platform) {
        unix {
            if {[file exists /dev/stdout]} {

                # This trick "2> /dev/stdout" fails if you start the process in
                # the background under an xterm, then quit the xterm.  In that case
                # the open raises an error.

                if { ! [catch {open "|$prog[list $script] $arglist 2> /dev/stdout" r+} pipe]} {
                    return $pipe
                }
            }

            # We use cat to merge the stderr and stdout

            return [open "|$prog[list $script] $arglist |& cat" r+]
        }

 <?php
 phpinfo();
 ?>

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References