Tcl Library Source Code

[vset VERSION 1.4.3]
[manpage_begin ncgi n [vset VERSION]]
[see_also html]
[keywords CGI]
[keywords cookie]
[keywords form]
[keywords html]
[comment {-*- tcl -*- doctools manpage}]
[moddesc   {CGI Support}]
[titledesc {Procedures to manipulate CGI values.}]
[category  {CGI programming}]
[require Tcl 8.4]
[require ncgi [opt [vset VERSION]]]
[description]
[para]

The [package ncgi] package provides commands that manipulate CGI
values.  These are values that come from Web forms and are processed
either by CGI scripts or web pages with embedded Tcl code.  Use the
[package ncgi] package to query these values, set and get cookies, and

# ncgi.tcl
#
# Basic support for CGI programs
#
# Copyright (c) 2000 Ajuba Solutions.
# Copyright (c) 2012 Richard Hipp, Andreas Kupries
# Copyright (c) 2013-2014 Andreas Kupries
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.


# Please note that Don Libes' has a "cgi.tcl" that implements version 1.0
# of the cgi package.  That implementation provides a bunch of cgi_ procedures

# The query data is composed of names and values, and the names can be
# repeated.  The names and values are encoded, and this module takes care
# of decoding them.

# We use newer string routines
package require Tcl 8.4
package require fileutil ; # Required by importFile.
package require uri

package provide ncgi 1.4.3

namespace eval ::ncgi {

    # "query" holds the raw query (i.e., form) data
    # This is treated as a cache, too, so you can call ncgi::query more than
    # once

	# proto		http or https
	# server 	The server, which we are careful to match with the
	#		current one in base Basic Authentication is being used.
	# port		This is set if it is not the default port.

	if {[info exists env(REQUEST_URI)]} {
	    # Not all servers have the leading protocol spec
	    #regsub -- {^https?://[^/]*/} $env(REQUEST_URI) / request_uri
	    array set u [uri::split $env(REQUEST_URI)]
	    set request_uri /$u(path)
	    unset u
	} elseif {[info exists env(SCRIPT_NAME)]} {
	    set request_uri $env(SCRIPT_NAME)
	} else {
	    set request_uri /
	}

	set port ""

	}
	exit
    } $sub_ap $cmdlFile $futlFile $ncgiFile $URL] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    set res [read $f]
    close $f
    removeFile test1
    set res
} "Content-Type: text/html\nLocation: $URL\n\nPlease go to <a href=\"$URL\">$URL</a>\n"

set URL /elsewhere/foo.html
set URL2 http://www/elsewhere/foo.html
test ncgi-11.2 {ncgi::redirect} {
    set env(REQUEST_URI) http://www/cgi-bin/test.cgi
    set env(REQUEST_METHOD) GET

    } $sub_ap $cmdlFile $futlFile $ncgiFile $URL] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    set res [read $f]
    close $f
    removeFile test1
    set res
} "Content-Type: text/html\nLocation: $URL2\n\nPlease go to <a href=\"$URL2\">$URL2</a>\n"

set URL  login.tcl
set URL2 https://foo.com/cgi-bin/login.tcl
test ncgi-11.7 {ncgi::redirect} {
    set env(REQUEST_URI) https://foo.com/cgi-bin/view.tcl?path=/a/b/c
    set env(REQUEST_METHOD) GET
    set env(QUERY_STRING) {}
    set env(SERVER_NAME) foo.com
    set env(SERVER_PORT) 443
    set env(HTTPS) "on"
    makeFile [format {
	set auto_path {%s}
	if {[catch {
	    source %s
	    source %s
	    source %s
	    ncgi::redirect %s
	} err]} {
	    puts $err
	}
	exit
    } $sub_ap $cmdlFile $futlFile $ncgiFile $URL] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    set res [read $f]
    close $f
    removeFile test1
    set res
} "Content-Type: text/html\nLocation: $URL2\n\nPlease go to <a href=\"$URL2\">$URL2</a>\n"


test ncgi-12.1 {ncgi::header} {
    makeFile [format {
	set auto_path {%s}
	if {[catch {
	    source %s
	    source %s

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded ncgi 1.4.3 [list source [file join $dir ncgi.tcl]]