14 | | [ns_info name]/[ns_info patchlevel] 15 | |
16 | }]] 17 | } 18 | %> 19 | 20 | -------------------------------------------------------------------------------- /revproxy/Makefile: -------------------------------------------------------------------------------- 1 | # 2 | # Name of the modules 3 | # 4 | MODNAME = revproxy 5 | 6 | # 7 | # List of components to be installed as the the Tcl module section 8 | # 9 | TCL = revproxy-procs.tcl \ 10 | revproxy-ns-http-procs.tcl \ 11 | revproxy-ns-connchan-procs.tcl 12 | 13 | # 14 | # Get the common Makefile rules 15 | # 16 | include ../include/Makefile.build 17 | -------------------------------------------------------------------------------- /revproxy/doc/mann/revproxy1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/naviserver-project/naviserver/db8928194324e89ca489d99bcc1f053e0012a276/revproxy/doc/mann/revproxy1.png -------------------------------------------------------------------------------- /simple-config.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # This is a fairly minimal NaviServer configuration file that makes the server to 3 | # accept HTTP requests on 0.0.0.0:8000 (IPv4) 4 | # 5 | # Logs are in the logs/nsd.log and logs/access.log 6 | # 7 | # When the nscp module is enabled it will accept telnet into nscp on 8 | # [::1]:2080 (IPv6) or 127.0.0.1:2080 (IPv4) 9 | # 10 | 11 | ns_section ns/servers { 12 | ns_param default NaviServer 13 | } 14 | ns_section ns/server/default/adp { 15 | ns_param map /*.adp 16 | } 17 | ns_section ns/server/default/modules { 18 | #ns_param nscp nscp 19 | ns_param nssock nssock 20 | ns_param nslog nslog 21 | } 22 | ns_section ns/server/default/module/nssock { 23 | ns_param address 0.0.0.0 24 | ns_param port 8000 25 | } 26 | -------------------------------------------------------------------------------- /tcl/tcloo.tcl: -------------------------------------------------------------------------------- 1 | # exclude the 8.6 TclOO namespace from blueprint creation for now, 2 | # as we don't yet know how to recreate all the artifacts 3 | 4 | nstrace::excludensp ::oo::* 5 | -------------------------------------------------------------------------------- /tcl/win32.tcl: -------------------------------------------------------------------------------- 1 | 2 | proc _ns_mktemp_win_temp_dir {} { 3 | # On Windows create the tempdir for use by ns_mktemp. 4 | if {! [set win_p [expr {{windows} eq $::tcl_platform(platform)}]]} { return } 5 | set dd [ns_config ns/parameters tmpdir] 6 | if {{} eq $dd} { set dd {c:/temp} } 7 | if {[file isdirectory $dd]} { 8 | ns_log Debug "Good, tmpdir exists: $dd" 9 | return 10 | } 11 | if {[catch {file mkdir $dd} errmsg ret_opts]} { 12 | ns_log Error "Creating tmpdir failed: $dd with Error:\n${errmsg}" 13 | } else { 14 | ns_log Notice "Successfully created tmpdir: $dd" 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /tests/compat.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | 3 | package require tcltest 2.2 4 | namespace import -force ::tcltest::* 5 | 6 | ::tcltest::configure {*}$argv 7 | 8 | testConstraint with_deprecated [dict get [ns_info buildinfo] with_deprecated] 9 | 10 | test ns_cp-1.1 {basic copy} -constraints with_deprecated -setup { 11 | makeFile "data" f1 12 | } -body { 13 | ns_cp f1 f2 14 | viewFile f2 15 | } -cleanup { 16 | removeFile f1 17 | removeFile f2 18 | } -result {data} 19 | 20 | 21 | 22 | cleanupTests 23 | 24 | # Local variables: 25 | # mode: tcl 26 | # tcl-indent-level: 4 27 | # indent-tabs-mode: nil 28 | # End: 29 | -------------------------------------------------------------------------------- /tests/errordoc.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | 3 | package require tcltest 2.2 4 | namespace import -force ::tcltest::* 5 | 6 | ::tcltest::configure {*}$argv 7 | 8 | 9 | 10 | test errordoc-1.1 {adp template} -setup { 11 | ns_register_proc GET /400error { ns_returnbadrequest "uh-oh" ;#} 12 | } -body { 13 | nstest::http -getbody 1 GET /400error 14 | } -cleanup { 15 | ns_unregister_op GET /400error 16 | } -match glob -result {400 *oops*} 17 | 18 | 19 | 20 | cleanupTests 21 | 22 | # Local variables: 23 | # mode: tcl 24 | # tcl-indent-level: 4 25 | # indent-tabs-mode: nil 26 | # End: 27 | -------------------------------------------------------------------------------- /tests/images/broken.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/naviserver-project/naviserver/db8928194324e89ca489d99bcc1f053e0012a276/tests/images/broken.gif -------------------------------------------------------------------------------- /tests/images/broken.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/naviserver-project/naviserver/db8928194324e89ca489d99bcc1f053e0012a276/tests/images/broken.jpg -------------------------------------------------------------------------------- /tests/images/color5x200.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/naviserver-project/naviserver/db8928194324e89ca489d99bcc1f053e0012a276/tests/images/color5x200.gif -------------------------------------------------------------------------------- /tests/images/color5x200.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/naviserver-project/naviserver/db8928194324e89ca489d99bcc1f053e0012a276/tests/images/color5x200.jpg -------------------------------------------------------------------------------- /tests/images/color5x200_progressive.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/naviserver-project/naviserver/db8928194324e89ca489d99bcc1f053e0012a276/tests/images/color5x200_progressive.jpg -------------------------------------------------------------------------------- /tests/images/empty.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/naviserver-project/naviserver/db8928194324e89ca489d99bcc1f053e0012a276/tests/images/empty.gif -------------------------------------------------------------------------------- /tests/images/empty.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/naviserver-project/naviserver/db8928194324e89ca489d99bcc1f053e0012a276/tests/images/empty.jpg -------------------------------------------------------------------------------- /tests/images/small.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/naviserver-project/naviserver/db8928194324e89ca489d99bcc1f053e0012a276/tests/images/small.gif -------------------------------------------------------------------------------- /tests/ns_addrbyhost.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | # 3 | # This Source Code Form is subject to the terms of the Mozilla Public 4 | # License, v. 2.0. If a copy of the MPL was not distributed with this 5 | # file, You can obtain one at https://mozilla.org/MPL/2.0/. 6 | # 7 | # The Initial Developer of the Original Code and related documentation 8 | # is America Online, Inc. Portions created by AOL are Copyright (C) 1999 9 | # America Online, Inc. All Rights Reserved. 10 | # 11 | # 12 | 13 | 14 | package require tcltest 2.2 15 | namespace import -force ::tcltest::* 16 | 17 | test ns_addrbyhost-1.0 {syntax: ns_addrbyhost} -body { 18 | ns_addrbyhost 19 | } -returnCodes {error ok} -result {wrong # args: should be "ns_addrbyhost ?-all? ?--? /hostname/"} 20 | 21 | test ns_addrbyhost-1.1 {good host} -body { 22 | set addr [ns_addrbyhost localhost] 23 | expr {[string match *.*.*.* $addr] || [string match *:* $addr]} 24 | } -result 1 25 | 26 | test ns_addrbyhost-1.2 {bad host} -body { 27 | ns_addrbyhost this_should_not_resolve 28 | } -returnCodes error -result {could not lookup this_should_not_resolve} 29 | 30 | 31 | 32 | cleanupTests 33 | 34 | # Local variables: 35 | # mode: tcl 36 | # tcl-indent-level: 4 37 | # indent-tabs-mode: nil 38 | # End: 39 | -------------------------------------------------------------------------------- /tests/ns_cond.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | 3 | # These two files work together for testing ns_cond: 4 | # tests/testserver/modules/nscond.tcl 5 | # tests/ns_cond.test 6 | 7 | package require tcltest 2.2 8 | namespace import -force ::tcltest::* 9 | ::tcltest::configure {*}$argv 10 | 11 | test ns_cond-1.1 { 12 | Master uses ns_cond to wake up a worker thread. 13 | } -body { 14 | set n_done [tst_cond_master] 15 | } -cleanup { 16 | tst_cond_cleanup 17 | } -result 5 18 | 19 | cleanupTests 20 | 21 | # Local variables: 22 | # mode: tcl 23 | # tcl-indent-level: 4 24 | # indent-tabs-mode: nil 25 | # End: 26 | -------------------------------------------------------------------------------- /tests/ns_conn_host.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | 3 | package require tcltest 2.2 4 | namespace import -force ::tcltest::* 5 | 6 | ::tcltest::configure {*}$argv 7 | 8 | #ns_logctl severity Debug(ns:driver) on 9 | 10 | if {[ns_config test listenport]} { 11 | testConstraint serverListen true 12 | } 13 | 14 | set port [ns_config "test" listenport] 15 | 16 | test ns_conn_host-1.1 {default location} -constraints serverListen -setup { 17 | ns_register_proc GET /location { 18 | ns_return 200 text/plain [ns_conn location] 19 | } 20 | } -body { 21 | nstest::http -getbody 1 -- GET /location 22 | } -cleanup { 23 | ns_unregister_op GET /location 24 | } -result [list 200 http://test:$port] 25 | 26 | 27 | 28 | test ns_conn_host-2.1 {virtual host location} -constraints serverListen -setup { 29 | ns_register_proc GET /location { 30 | ns_return 200 text/plain [ns_conn location] 31 | } 32 | } -body { 33 | nstest::http -getbody 1 -setheaders [list host testvhost:$port] -- GET /location 34 | } -result [list 200 http://testvhost:$port] 35 | 36 | # Test bad host headers 37 | 38 | test ns_conn_host-2.2 {multiple host header fields} -constraints serverListen -setup { 39 | ns_register_proc GET /location { 40 | ns_return 200 text/plain [ns_conn location] 41 | } 42 | } -body { 43 | nstest::http -getbody 1 -setheaders [list host testvhost:$port Host testvhost2:$port] -- GET /location 44 | } -result {400} 45 | 46 | 47 | # Custom location 48 | 49 | test ns_conn_host-3.1 {custom location} -constraints serverListen -body { 50 | nstest::http -getbody 1 -setheaders [list host testvhost2:$port] -- GET /location 51 | } -result {200 testlocation.arg} 52 | 53 | 54 | 55 | cleanupTests 56 | 57 | # Local variables: 58 | # mode: tcl 59 | # tcl-indent-level: 4 60 | # indent-tabs-mode: nil 61 | # End: 62 | -------------------------------------------------------------------------------- /tests/ns_gifsize.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | # 3 | # Thanks to Michael P. Lex (Kinetiqa) 4 | # 5 | 6 | package require tcltest 2.2 7 | namespace import -force ::tcltest::* 8 | 9 | set testdir [ns_config test home] 10 | 11 | 12 | 13 | test ns_gifsize-1.1 {syntax} -body { 14 | ns_gifsize 15 | } -returnCodes error -result {wrong # args: should be "ns_gifsize /filename/"} 16 | 17 | 18 | test ns_gifsize-2.1 {file does not exist} -body { 19 | ns_gifsize "${testdir}/images/noexist.gif" 20 | } -returnCodes error -match "glob" -result {couldn't open "*": no such file or directory} 21 | 22 | test ns_gifsize-2.2 {file is empty} -body { 23 | ns_gifsize "${testdir}/images/empty.gif" 24 | } -returnCodes error -match "glob" -result {invalid GIF file*} 25 | 26 | test ns_gifsize-2.3 {file is broken} -body { 27 | ns_gifsize "${testdir}/images/broken.gif" 28 | } -returnCodes error -match "glob" -result {invalid GIF file*} 29 | 30 | test ns_gifsize-2.4 {normal indexed gif} -body { 31 | ns_gifsize "${testdir}/images/color5x200.gif" 32 | } -returnCodes {error ok} -result [list 5 200] 33 | 34 | test ns_gifsize-2.5 {small gif} -body { 35 | ns_gifsize "${testdir}/images/small.gif" 36 | } -returnCodes {error ok} -result [list 1 1] 37 | 38 | cleanupTests 39 | 40 | # Local variables: 41 | # mode: tcl 42 | # tcl-indent-level: 4 43 | # indent-tabs-mode: nil 44 | # End: 45 | -------------------------------------------------------------------------------- /tests/ns_hashpath.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | 3 | package require tcltest 2.2 4 | namespace import -force ::tcltest::* 5 | 6 | ::tcltest::configure {*}$argv 7 | 8 | 9 | test ns_hashpath-1.1 {basic syntax} -body { 10 | ns_hashpath 11 | } -returnCodes error -result {wrong # args: should be "ns_hashpath /string/ /levels[1,MAX]/"} 12 | 13 | test ns_hashpath-1.2 {basic syntax} -body { 14 | ns_hashpath "" 0 15 | } -returnCodes error -result {expected integer in range [1,MAX] for 'levels', but got 0} 16 | 17 | test ns_hashpath-1.3 {basic syntax} -body { 18 | ns_hashpath "" -1 19 | } -returnCodes error -result {expected integer in range [1,MAX] for 'levels', but got -1} 20 | 21 | test ns_hashpath-1.4 {basic syntax} -body { 22 | ns_hashpath "" notanum 23 | } -returnCodes error -result {expected integer but got "notanum"} 24 | 25 | 26 | 27 | test ns_hashpath-2.1 {paths} -body { 28 | ns_hashpath x 1 29 | } -result /x 30 | 31 | test ns_hashpath-2.2 {paths} -body { 32 | ns_hashpath xxx 1 33 | } -result /x 34 | 35 | test ns_hashpath-2.3 {paths} -body { 36 | ns_hashpath xxx 2 37 | } -result /x/x 38 | 39 | test ns_hashpath-2.4 {paths} -body { 40 | ns_hashpath xxx 3 41 | } -result /x/x/x 42 | 43 | 44 | 45 | test ns_hashpath-3.1 {short paths} -body { 46 | ns_hashpath x 2 47 | } -result /x/_ 48 | 49 | test ns_hashpath-3.1 {short paths} -body { 50 | ns_hashpath x 3 51 | } -result /x/_/_ 52 | 53 | test ns_hashpath-3.1 {short paths} -body { 54 | ns_hashpath xx 3 55 | } -result /x/x/_ 56 | 57 | 58 | 59 | 60 | cleanupTests 61 | 62 | # Local variables: 63 | # mode: tcl 64 | # tcl-indent-level: 4 65 | # indent-tabs-mode: nil 66 | # End: 67 | -------------------------------------------------------------------------------- /tests/ns_hostbyaddr.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | # 3 | # This Source Code Form is subject to the terms of the Mozilla Public 4 | # License, v. 2.0. If a copy of the MPL was not distributed with this 5 | # file, You can obtain one at https://mozilla.org/MPL/2.0/. 6 | # 7 | # The Initial Developer of the Original Code and related documentation 8 | # is America Online, Inc. Portions created by AOL are Copyright (C) 1999 9 | # America Online, Inc. All Rights Reserved. 10 | # 11 | # 12 | 13 | package require tcltest 2.2 14 | namespace import -force ::tcltest::* 15 | 16 | # "-constraints {noOldDarwin}" in the following two tests does not seem 17 | # necessary in newest macOS installations. On macOS 10.8 18 | # (Darwin 12.*), everything seems fine, on 10.7 (Darwin 11.*), the 19 | # first test does not hold. 20 | 21 | set ::noOldDarwin 1 22 | if {$::tcl_platform(os) eq "Darwin"} { 23 | if {[lindex [split $::tcl_platform(osVersion) .] 0] < 12} { 24 | set ::noOldDarwin 0 25 | } 26 | } 27 | 28 | tcltest::testConstraint noOldDarwin $::noOldDarwin 29 | 30 | test ns_hostbyaddr-1.0 {syntax: ns_hostbyaddr} -constraints {macOrUnix} -body { 31 | ns_hostbyaddr 32 | } -returnCodes {error ok} -result {wrong # args: should be "ns_hostbyaddr /address/"} 33 | 34 | test ns_hostbyaddr-1.1 {good address} -constraints noOldDarwin -body { 35 | ns_hostbyaddr [ns_config test loopback] ;#127.0.0.1 36 | } -match glob -result * 37 | 38 | test ns_hostbyaddr-1.2 {bad address} -constraints {macOrUnix} -body { 39 | ns_hostbyaddr 0.0.0.0 40 | } -returnCodes {error ok} -result {could not lookup 0.0.0.0} 41 | 42 | 43 | cleanupTests 44 | 45 | # Local variables: 46 | # mode: tcl 47 | # tcl-indent-level: 4 48 | # indent-tabs-mode: nil 49 | # End: 50 | -------------------------------------------------------------------------------- /tests/ns_jpegsize.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | # 3 | # Thanks to Michael P. Lex (Kinetiqa) 4 | # 5 | 6 | package require tcltest 2.2 7 | namespace import -force ::tcltest::* 8 | 9 | set testdir [ns_config test home] 10 | 11 | 12 | 13 | test ns_jpegsize-1.1 {syntax} -body { 14 | ns_jpegsize 15 | } -returnCodes error -result {wrong # args: should be "ns_jpegsize /filename/"} 16 | 17 | 18 | test ns_jpegsize-2.1 {file does not exist} -body { 19 | ns_jpegsize "${testdir}/images/noexist.jpg" 20 | } -returnCodes error -match "glob" -result {couldn't open "*": no such file or directory} 21 | 22 | test ns_jpegsize-2.2 {file is empty} -body { 23 | ns_jpegsize "${testdir}/images/empty.jpg" 24 | } -returnCodes error -match "glob" -result {invalid JPEG file*} 25 | 26 | test ns_jpegsize-2.3 {file is broken} -body { 27 | ns_jpegsize "${testdir}/images/broken.jpg" 28 | } -returnCodes error -match "glob" -result {invalid JPEG file*} 29 | 30 | test ns_jpegsize-2.4 {normal jpeg} -body { 31 | ns_jpegsize "${testdir}/images/color5x200.jpg" 32 | } -result [list 5 200] 33 | 34 | test ns_jpegsize-2.5 {normal progressive jpeg} -body { 35 | ns_jpegsize "${testdir}/images/color5x200_progressive.jpg" 36 | } -result [list 5 200] 37 | 38 | cleanupTests 39 | 40 | # Local variables: 41 | # mode: tcl 42 | # tcl-indent-level: 4 43 | # indent-tabs-mode: nil 44 | # End: 45 | -------------------------------------------------------------------------------- /tests/ns_mime.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | 3 | package require tcltest 2.2 4 | namespace import -force ::tcltest::* 5 | 6 | ::tcltest::configure {*}$argv 7 | 8 | 9 | test ns_guesstype-5.1 {basic syntax: ns_guesstype} -body { 10 | ns_guesstype 11 | } -returnCodes error -result {wrong # args: should be "ns_guesstype /filename/"} 12 | 13 | test ns_guesstype-5.2 {no extension} -body { 14 | ns_guesstype x 15 | } -result "*/*" 16 | 17 | test ns_guesstype-5.3 {no extension, path} -body { 18 | ns_guesstype /x/y/z 19 | } -result "*/*" 20 | 21 | test ns_guesstype-5.4 {path, extension} -body { 22 | ns_guesstype /x/y/z.txt 23 | } -result "text/plain" 24 | 25 | 26 | test ns_guesstype-6.1 {spot check: .html} -body { 27 | ns_guesstype "filename.html" 28 | } -match "glob" -result "text/html*" 29 | 30 | test ns_guesstype-6.2 {spot check: .gif} -body { 31 | ns_guesstype "filename.gif" 32 | } -result "image/gif" 33 | 34 | 35 | 36 | cleanupTests 37 | 38 | # Local variables: 39 | # mode: tcl 40 | # tcl-indent-level: 4 41 | # indent-tabs-mode: nil 42 | # End: 43 | -------------------------------------------------------------------------------- /tests/ns_sha1.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | 3 | package require tcltest 2.2 4 | namespace import -force ::tcltest::* 5 | 6 | ::tcltest::configure {*}$argv 7 | 8 | test ns_sha1-1.1 {basic syntax: plain call} -body { 9 | ns_sha1 10 | } -returnCodes error -result {wrong # args: should be "ns_sha1 ?-binary? ?--? /string/"} 11 | 12 | 13 | test ns_sha1-2.1 {basic operation} -body { 14 | ns_sha1 foo 15 | } -result "0BEEC7B5EA3F0FDBC95D0DD47F3C5BC275DA8A33" 16 | 17 | test ns_sha1-2.2 {basic operation} -body { 18 | for {set i 0} {$i < 999} {incr i +1} { 19 | set nssha1([ns_sha1 foo]) . 20 | } 21 | llength [array names nssha1] 22 | } -cleanup { 23 | array unset nssha1 24 | } -result 1 25 | 26 | test ns_sha1-2.3 {basic operation} -body { 27 | for {set i 0} {$i < 999} {incr i +1} { 28 | set nssha1([ns_sha1 $i]) . 29 | } 30 | llength [array names nssha1] 31 | } -cleanup { 32 | array unset nssha1 33 | } -result 999 34 | 35 | test ns_sha1-2.4 {basic operation} -body { 36 | set hash1 [ns_sha1 ""] 37 | set hash2 [ns_sha1 {}] 38 | set hash3 [ns_sha1 [array names fjfjfjfjfj]] 39 | expr {($hash1 eq $hash2) == ($hash2 eq $hash3)} 40 | } -result 1 41 | 42 | test ns_sha1-2.5 {basic operation} -body { 43 | ns_sha1 [binary format H* 6501ff01] 44 | } -result "97CE1CD8E5D85BA0913976868BC3EB024F6DD214" 45 | 46 | test ns_sha1-2.6 {checksum from binary file} -body { 47 | set f [open [ns_server pagedir]/ns_poweredby.png] 48 | fconfigure $f -translation binary 49 | set c [read $f] 50 | close $f 51 | ns_sha1 $c 52 | } -result "1BFB30C1892435CA0AD6042FA80CE6B222E5121A" 53 | 54 | cleanupTests 55 | 56 | # Local variables: 57 | # mode: tcl 58 | # tcl-indent-level: 4 59 | # indent-tabs-mode: nil 60 | # End: 61 | -------------------------------------------------------------------------------- /tests/ns_thread_crash.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | 3 | package require tcltest 2.2 4 | namespace import -force ::tcltest::* 5 | 6 | ::tcltest::configure {*}$argv 7 | 8 | if {![catch {package require Thread}]} { 9 | testConstraint Thread true 10 | } 11 | #ns_log notice "====================starting t1" 12 | 13 | test t-1 {object type conversion / display} -body { 14 | set tid [ns_thread create {set x 1}] 15 | ns_thread wait $tid 16 | } -cleanup { 17 | unset -nocomplain -- tid 18 | } -result {1} 19 | 20 | #ns_log notice "====================starting t2" 21 | test tclconnio-3.1 {thread detach, raw} -constraints Thread -setup { 22 | ns_register_proc GET /tclconnio { 23 | package require Thread 24 | set tid [thread::create] 25 | thread::release $tid 26 | ns_return 200 text/plain 1 27 | } 28 | } -body { 29 | nstest::http -getbody 1 -getheaders {content-length connection} GET /tclconnio 30 | } -cleanup { 31 | ns_unregister_op GET /tclconnio 32 | } -result {200 1 close 1} 33 | 34 | #ns_log notice "====================cleanupTests" 35 | cleanupTests 36 | #ns_log notice "====================cleanupTests DONE" 37 | 38 | # Local variables: 39 | # mode: tcl 40 | # tcl-indent-level: 4 41 | # indent-tabs-mode: nil 42 | # End: 43 | -------------------------------------------------------------------------------- /tests/ns_uuencode.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | # 3 | # This Source Code Form is subject to the terms of the Mozilla Public 4 | # License, v. 2.0. If a copy of the MPL was not distributed with this 5 | # file, You can obtain one at https://mozilla.org/MPL/2.0/. 6 | # 7 | # The Initial Developer of the Original Code and related documentation 8 | # is America Online, Inc. Portions created by AOL are Copyright (C) 1999 9 | # America Online, Inc. All Rights Reserved. 10 | # 11 | # 12 | 13 | package require tcltest 2.2 14 | namespace import -force ::tcltest::* 15 | 16 | test ns_uuencode-0.1 {basic syntax: plain call} -body { 17 | ns_uuencode 18 | } -returnCodes error -result {wrong # args: should be "ns_uuencode ?-binary? ?--? /string/"} 19 | 20 | test ns_uudecode-0.2 {basic syntax: plain call} -body { 21 | ns_uudecode 22 | } -returnCodes error -result {wrong # args: should be "ns_uudecode ?-binary? ?-strict? ?--? /string/"} 23 | 24 | test ns_uuencode-1.1 {long string} -body { 25 | ns_uuencode 1234567890 26 | } -result MTIzNDU2Nzg5MA== 27 | 28 | test ns_uuencode-1.2 {short string} -body { 29 | ns_uuencode @ 30 | } -result QA== 31 | 32 | test ns_uudecode-1.3 {encoded string} -body { 33 | ns_uudecode MTIzNDU2Nzg5MA== 34 | } -result 1234567890 35 | 36 | test ns_uuencode-2.1 {basic operation ns_uuencode} -body { 37 | ns_uuencode "true friends stab you in the front" 38 | } -result "dHJ1ZSBmcmllbmRzIHN0YWIgeW91IGluIHRoZSBmcm9udA==" 39 | 40 | test ns_uudecode-2.2 {basic operation ns_uudecode} -body { 41 | ns_uudecode "dHJ1ZSBmcmllbmRzIHN0YWIgeW91IGluIHRoZSBmcm9udA==" 42 | } -result "true friends stab you in the front" 43 | 44 | cleanupTests 45 | 46 | # 47 | # Local variables: 48 | # mode: tcl 49 | # tcl-indent-level: 4 50 | # indent-tabs-mode: nil 51 | # End: 52 | -------------------------------------------------------------------------------- /tests/nscp.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | 3 | package require tcltest 2.2 4 | namespace import -force ::tcltest::* 5 | 6 | ::tcltest::configure {*}$argv 7 | 8 | testConstraint nscpLoaded [expr {[info commands ::nscp] ne ""}] 9 | 10 | test nscp-1.0 {basic syntax "nscp"} -constraints nscpLoaded -body { 11 | nscp 12 | } -returnCodes error -result {wrong # args: should be "nscp users ?/arg .../"} 13 | 14 | test nscp-1.1 {basic syntax "nscp users"} -constraints nscpLoaded -body { 15 | nscp users x 16 | } -returnCodes error -result {wrong # args: should be "nscp users"} 17 | 18 | test nscp-2.0 {return users from config file} -constraints nscpLoaded -body { 19 | nscp users 20 | } -returnCodes {ok error} -result {{} nsadmin} 21 | 22 | cleanupTests 23 | 24 | # Local variables: 25 | # mode: tcl 26 | # tcl-indent-level: 4 27 | # indent-tabs-mode: nil 28 | # End: 29 | -------------------------------------------------------------------------------- /tests/progress.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | # 3 | # This Source Code Form is subject to the terms of the Mozilla Public 4 | # License, v. 2.0. If a copy of the MPL was not distributed with this 5 | # file, You can obtain one at https://mozilla.org/MPL/2.0/. 6 | # 7 | # The Initial Developer of the Original Code and related documentation 8 | # is America Online, Inc. Portions created by AOL are Copyright (C) 1999 9 | # America Online, Inc. All Rights Reserved. 10 | # 11 | # 12 | 13 | package require tcltest 2.2 14 | namespace import -force ::tcltest::* 15 | 16 | ::tcltest::configure {*}$argv 17 | 18 | 19 | 20 | test progress-1.1 {basic command} -body { 21 | ns_upload_stats 22 | } -returnCodes error -result {wrong # args: should be "ns_upload_stats /key/"} 23 | 24 | test progress-1.2 {no progress} -body { 25 | ns_upload_stats url-which-does-not-exist 26 | } -result {} 27 | 28 | 29 | # 30 | # TODO: Active progress... 31 | # 32 | 33 | 34 | 35 | cleanupTests 36 | 37 | # Local variables: 38 | # mode: tcl 39 | # tcl-indent-level: 4 40 | # indent-tabs-mode: nil 41 | # End: 42 | -------------------------------------------------------------------------------- /tests/revproxy.test: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | 3 | package require tcltest 2.2 4 | namespace import -force ::tcltest::* 5 | 6 | ::tcltest::configure {*}$argv 7 | 8 | # 9 | # Most of these tests require the OpenSSL API, some require nsf 10 | # 11 | tcltest::testConstraint nsf [expr {[info commands ::nsf::proc] ne ""}] 12 | 13 | test revproxy-1.0 {syntax test} -constraints {nsf} -body { 14 | revproxy::upstream 15 | } -match glob -returnCodes error -result {required argument 'when' is missing, should be:*revproxy::upstream /when/ -target /value/ ?-backend_reply_callback /value/? ?-backend_response_callback /value/? ?-backendconnection /value/? ?-connecttimeout /value/? ?-exception_callback /value/? ?-insecure? ?-receivetimeout /value/? ?-regsubs /value .../? ?-response_header_callback /value/? ?-sendtimeout /value/? ?-targethost /value/? ?-timeout /value/? ?-url_rewrite_callback /value/? ?-use_target_host_header /boolean/? ?-validation_callback /value/?} 16 | 17 | # emulated {wrong # args: should be "revproxy::upstream /when/ -target /value/ ?-backendconnection /value/? ?-insecure? ?-connecttimeout /value/? ?-receivetimeout /value/? ?-sendtimeout /value/? ?-timeout /value/? ?-use_target_host_header true|false? ?-targethost /value/? ?-regsubs /value .../? ?-url_rewrite_callback /value/? ?-response_header_callback /value/? ?-backend_response_callback /value/? ?-exception_callback /value/? ?-validation_callback /value/?"} 18 | -------------------------------------------------------------------------------- /tests/testserver/certificates/TESTKEY.pem: -------------------------------------------------------------------------------- 1 | -----BEGIN RSA PRIVATE KEY----- 2 | MIIBOwIBAAJBAMv7Reawnxr0DfYN3IZbb5ih/XJGeLWDv7WuhTlie//c2TDXw/mW 3 | 914VFyoBfxQxAezSj8YpuADiTwqDZl13wKMCAwEAAQJAYaTrFT8/KpvhgwOnqPlk 4 | NmB0/psVdW6X+tSMGag3S4cFid3nLkN384N6tZ+na1VWNkLy32Ndpxo6pQq4NSAb 5 | YQIhAPNlJsV+Snpg+JftgviV5+jOKY03bx29GsZF+umN6hD/AiEA1ouXAO2mVGRk 6 | BuoGXe3o/d5AOXj41vTB8D6IUGu8bF0CIQC6zah7LRmGYYSKPk0l8w+hmxFDBAex 7 | IGE7SZxwwm2iCwIhAInnDbe2CbyjDrx2/oKvopxTmDqY7HHWvzX6K8pthZ6tAiAw 8 | w+DJoSx81QQpD8gY/BXjovadVtVROALaFFvdmN64sw== 9 | -----END RSA PRIVATE KEY----- 10 | -------------------------------------------------------------------------------- /tests/testserver/certificates/openssl.cnf: -------------------------------------------------------------------------------- 1 | [ req ] 2 | prompt = no 3 | distinguished_name = req_distinguished_name 4 | 5 | [ req_distinguished_name ] 6 | C = AT 7 | ST = Test State or Province 8 | L = Test Locality 9 | O = Organization Name 10 | OU = Organizational Unit Name 11 | CN = Common Name 12 | emailAddress = test@email.address -------------------------------------------------------------------------------- /tests/testserver/cgi/info.tclcgi: -------------------------------------------------------------------------------- 1 | ../pages/info.cgi -------------------------------------------------------------------------------- /tests/testserver/cgi/resource-cgi.txt: -------------------------------------------------------------------------------- 1 | ../pages/10bytes -------------------------------------------------------------------------------- /tests/testserver/cgi/sub/resource-cgi-sub.txt: -------------------------------------------------------------------------------- 1 | ../resource-cgi.txt -------------------------------------------------------------------------------- /tests/testserver/modules/init-test.tcl: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | # 3 | # This Source Code Form is subject to the terms of the Mozilla Public 4 | # License, v. 2.0. If a copy of the MPL was not distributed with this 5 | # file, You can obtain one at https://mozilla.org/MPL/2.0/. 6 | # 7 | # The Initial Developer of the Original Code and related documentation 8 | # is America Online, Inc. Portions created by AOL are Copyright (C) 1999 9 | # America Online, Inc. All Rights Reserved. 10 | # 11 | # 12 | 13 | # init-test.tcl - 14 | # 15 | # Support routines for the tests in tests/init.test 16 | # 17 | 18 | # 19 | # A simple proc which should be replicated in all interps after startup. 20 | # 21 | 22 | proc testproc1 {} { 23 | ns_log notice testproc1 24 | } 25 | 26 | # 27 | # A namespaced proc which should be replicated in all interps after startup. 28 | # 29 | 30 | namespace eval testnamespace {} 31 | 32 | proc testnamespace::testproc2 {} { 33 | ns_log notice testproc1 34 | } 35 | 36 | # 37 | # Variables in the global namespace should not get replicated. 38 | # 39 | 40 | set testglobalvariable 1 41 | 42 | # 43 | # Variables in namespaces should not get replicated? 44 | # 45 | 46 | set testnamespace::testvariable2 1 47 | 48 | interp alias {} ::testalias1 {} testproc1 49 | interp alias {} ::testnamespace::testalias2 {} testnamespace::testproc2 50 | interp alias {} testalias11 {} testproc1 51 | interp alias {} testnamespace::testalias12 {} testnamespace::testproc2 52 | -------------------------------------------------------------------------------- /tests/testserver/modules/listencallback-procs.tcl: -------------------------------------------------------------------------------- 1 | namespace eval ::ns_listencallback { 2 | proc conn_handler {rfd wfd} { 3 | #ns_log notice "--- conn_handler called with $rfd $wfd" 4 | puts $wfd "Welcome to the test server" 5 | flush $wfd 6 | #ns_log notice "--- conn_handler reads from $rfd" 7 | gets $rfd line 8 | #ns_log notice "--- conn_handler got <$line>" 9 | puts $wfd "Well isn't that nice" 10 | flush $wfd 11 | } 12 | } 13 | 14 | # Local variables: 15 | # mode: tcl 16 | # tcl-indent-level: 4 17 | # indent-tabs-mode: nil 18 | # End: 19 | -------------------------------------------------------------------------------- /tests/testserver/modules/ns_filter.tcl: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | 3 | # These two files work together for testing ns_cond: 4 | # tests/testserver/modules/nscond.tcl 5 | # tests/ns_cond.test 6 | 7 | proc ::_ns_filter_test {what result args} { 8 | #ns_log notice "CALLED ::_ns_filter_test $what $result <$args>" 9 | if {[llength $args] ne 0} { 10 | set script [lindex $args 0] 11 | eval $script 12 | } 13 | return $result 14 | } 15 | 16 | 17 | # Local variables: 18 | # mode: tcl 19 | # tcl-indent-level: 4 20 | # indent-tabs-mode: nil 21 | # End: 22 | -------------------------------------------------------------------------------- /tests/testserver/modules/vhost.tcl: -------------------------------------------------------------------------------- 1 | # -*- Tcl -*- 2 | # 3 | # This Source Code Form is subject to the terms of the Mozilla Public 4 | # License, v. 2.0. If a copy of the MPL was not distributed with this 5 | # file, You can obtain one at https://mozilla.org/MPL/2.0/. 6 | # 7 | # Copyright (C) 2005 Stephen Deasey
24 | <%
25 | set result ""
26 | if {[lsearch $infos $g] >= 0} {
27 | set result [join [lsort [ns_info $g]] \n]
28 | } elseif {$q != ""} {
29 | set err [catch {set result [eval $q]} errMsg]
30 | if $err {
31 | ns_puts "Tcl Error:
"
32 | ns_puts [ns_quotehtml $errMsg]
33 | } else {
34 | ns_puts "Tcl Output:
"
35 | switch $g {
36 | join {
37 | set result [join $result \n]
38 | }
39 | sort {
40 | set result [join [lsort $result] \n]
41 | }
42 | }
43 | }
44 | }
45 | ns_puts [ns_quotehtml $result]
46 | %>
47 |
48 |
--------------------------------------------------------------------------------
/win32/cgitest/main.c:
--------------------------------------------------------------------------------
1 | /*
2 | * This Source Code Form is subject to the terms of the Mozilla Public
3 | * License, v. 2.0. If a copy of the MPL was not distributed with this
4 | * file, You can obtain one at https://mozilla.org/MPL/2.0/.
5 | *
6 | * The Initial Developer of the Original Code and related documentation
7 | * is America Online, Inc. Portions created by AOL are Copyright (C) 1999
8 | * America Online, Inc. All Rights Reserved.
9 | *
10 | */
11 | #include
24 | <%
25 | set result ""
26 | if {[lsearch $infos $g] >= 0} {
27 | set result [join [lsort [ns_info $g]] \n]
28 | } elseif {$q != ""} {
29 | set err [catch {set result [eval $q]} errMsg]
30 | if $err {
31 | ns_puts "Tcl Error:
"
32 | ns_puts [ns_quotehtml $errMsg]
33 | } else {
34 | ns_puts "Tcl Output:
"
35 | switch $g {
36 | join {
37 | set result [join $result \n]
38 | }
39 | sort {
40 | set result [join [lsort $result] \n]
41 | }
42 | }
43 | }
44 | }
45 | ns_puts [ns_quotehtml $result]
46 | %>
47 |
48 |
--------------------------------------------------------------------------------