Tcl Library Source Code

test comm-6.0 {secured communication via tls package} hastls {
    # Setup secured channel in main process.
    tls::init \
	-keyfile  [tcllibPath devtools/receiver.key] \
	-certfile [tcllibPath devtools/receiver.crt] \
	-cafile   [tcllibPath devtools/ca.crt] \
	-ssl2 0    \
	-ssl3 0    \
	-tls1 1    \
	-require 1
    comm::comm new BAR -socketcmd tls::socket -listen 1

    # Setup secured channel in slave process
    ::comm::comm send [slave] {
	package require tls
	set fox dog
    }
    ::comm::comm send [slave] \
	[list \
	     tls::init \
	     -keyfile  [tcllibPath devtools/transmitter.key] \
	     -certfile [tcllibPath devtools/transmitter.crt] \
	     -cafile   [tcllibPath devtools/ca.crt] \
	     -ssl2 0    \
	     -ssl3 0    \
	     -tls1 1    \
	     -require 1]
    set FOO [::comm::comm send [slave] {
	comm::comm new FOO -socketcmd tls::socket -listen 1
	FOO self
    }] ; # {}

    # Run command interaction over the secured channel

[vset VERSION 1.1.3]
[manpage_begin crc16 n [vset VERSION]]
[see_also cksum(n)]
[see_also crc32(n)]
[see_also sum(n)]
[keywords checksum]
[keywords cksum]
[keywords crc]
[keywords crc16]
[keywords crc32]
[keywords {cyclic redundancy check}]
[keywords {data integrity}]
[keywords security]
[copyright {2002, 2017, Pat Thoyts}]
[moddesc   {Cyclic Redundancy Checks}]
[titledesc {Perform a 16bit Cyclic Redundancy Check}]
[category  {Hashes, checksums, and encryption}]
[require Tcl 8.2]
[require crc16 [opt [vset VERSION]]]
[description]
[para]

This package provides a Tcl-only implementation of the CRC
algorithms based upon information provided at
http://www.microconsultants.com/tips/crc/crc.txt

There are a number of permutations available for calculating CRC
checksums and this package can handle all of them. Defaults are set up
for the most common cases.

[section COMMANDS]

[list_begin definitions]

[call [cmd ::crc::crc16] [opt "-format [arg format]"] \
  [opt "-seed [arg value]"] [opt "-implementation [arg procname]"] [arg -- message]]
[call [cmd ::crc::crc16] [opt "-format [arg format]"] \
  [opt "-seed [arg value]"] [opt "-implementation [arg procname]"] "-filename [arg file]"]
[call [cmd ::crc::crc-ccitt] [opt "-format [arg format]"] \
  [opt "-seed [arg value]"] [opt "-implementation [arg procname]"] [arg -- message]]
[call [cmd ::crc::crc-ccitt] [opt "-format [arg format]"] \
  [opt "-seed [arg value]"] [opt "-implementation [arg procname]"] "-filename [arg file]"]
[call [cmd ::crc::xmodem] [opt "-format [arg format]"] \
  [opt "-seed [arg value]"] [opt "-implementation [arg procname]"] [arg -- message]]
[call [cmd ::crc::xmodem] [opt "-format [arg format]"] \
  [opt "-seed [arg value]"] [opt "-implementation [arg procname]"] "-filename [arg file]"]

The command takes either string data or a file name and returns a checksum
value calculated using the CRC algorithm. The command used sets up the
CRC polynomial, initial value and bit ordering for the desired
standard checksum calculation. The result is formatted

The package provides some implementations of standard CRC polynomials
for the XMODEM, CCITT and the usual CRC-16 checksum. For convenience,
additional commands have been provided that make use of these
implementations.

[def "--"]

Terminate option processing. Please note that using the option
termination flag is important when processing data from parameters. If
the binary data looks like one of the options given above then the
data will be read as an option if this marker is not included.

Always use the [arg --] option termination flag before giving the data
argument.

[list_end]

[section EXAMPLES]

[para]
[example {
% crc::crc16 -- "Hello, World!"
64077
}]

[para]
[example {
% crc::crc-ccitt -- "Hello, World!"
26586
}]

[para]
[example {
% crc::crc16 -format 0x%X -- "Hello, World!"
0xFA4D
}]

[para]
[example {
% crc::crc16 -file crc16.tcl
51675

# crc16.tcl -- Copyright (C) 2002, 2017 Pat Thoyts <[email protected]>
#
# Cyclic Redundancy Check - this is a Tcl implementation of a general
# table-driven CRC implementation. This code should be able to generate
# the lookup table and implement the correct algorithm for most types
# of CRC. CRC-16, CRC-32 and the CCITT version of CRC-16. [1][2][3]
# Most transmission CRCs use the CCITT polynomial (including X.25, SDLC
# and Kermit).

            -i*   { set opts(impl) [uplevel 1 namespace origin [Pop args 1]] }
            -s*   { set opts(seed) [Pop args 1] }
            default {
                if {[llength $args] == 1} { break }
                if {[string compare $option "--"] == 0} { Pop args; break }
                set options [join [lsort [array names opts]] ", -"]
                return -code error "bad option $option:\
                       must be one of -$options or -- to indicate end of options"
            }
        }
        Pop args
    }

    if {$opts(filename) != {}} {
        set opts(channel) [open $opts(filename) r]

        if {$opts(filename) != {}} {
            close $opts(channel)
        }
    } else {
        if {[llength $args] != 1} {
            return -code error "wrong \# args: should be\
                   \"crc16 ?-format string? ?-seed value? ?-impl procname?\
                   -file name | -- data\""
        }
        set r [$opts(impl) [lindex $args 0] $opts(seed)]
    }
    return [format $opts(format) $r]
}

# -------------------------------------------------------------------------

proc ::crc::crc-32 {args} {
    return [eval [list crc -impl [namespace origin CRC-32] -seed 0xFFFFFFFF]\
                $args]
}

# -------------------------------------------------------------------------

package provide crc16 1.1.3

# -------------------------------------------------------------------------
#
# Local variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End:

if {![package vsatisfies [package provide Tcl] 8.2]} {return}
package ifneeded cksum 1.1.4 [list source [file join $dir cksum.tcl]]
package ifneeded crc16 1.1.3 [list source [file join $dir crc16.tcl]]
package ifneeded crc32 1.3.2 [list source [file join $dir crc32.tcl]]
package ifneeded sum   1.1.2 [list source [file join $dir sum.tcl]]

	coserv::run $id {
	    package require tls

	    tls::init \
		-keyfile  $devtools/transmitter.key \
		-certfile $devtools/transmitter.crt \
		-cafile   $devtools/ca.crt \
		-ssl2 0    \
		-ssl3 0    \
		-tls1 1    \
		-require 1

	    proc Server {} {
		global port
		# Start listener for dialog
		set listener [tls::socket -server Accept 0]
		set port     [lindex [fconfigure $listener -sockname] 2]

2017-10-28  Pat Thoyts  <[email protected]>

	* autoproxy.tcl: allow unsetting basic auth information
	* autoproxy.test: added basic tests of the package options
	* autoproxy.man: update documentation for "configure -basic --"
	Bumped to version 1.5.4 given new option.

2013-02-01  Andreas Kupries  <[email protected]>

	*
	* Released and tagged Tcllib 1.15 ========================
	* 

2012-05-28  Andreas Kupries  <[email protected]>

[vset VERSION 1.6]
[manpage_begin autoproxy n [vset VERSION]]
[see_also http(n)]
[keywords authentication]
[keywords http]
[keywords proxy]
[moddesc   {HTTP protocol helper modules}]
[titledesc {Automatic HTTP proxy usage and authentication}]
[category  Networking]
[require Tcl 8.2]
[require http [opt 2.0]]
[require autoproxy [opt [vset VERSION]]]
[description]
[para]

This package attempts to automate the use of HTTP proxy servers in Tcl
HTTP client code. It tries to initialize the web access settings from
system standard locations and can be configured to negotiate
authentication with the proxy if required.

called when [cmd configure] [option -basic] is called with either no or
insufficient authentication details. This can be used to present a
dialog to the user to request the additional information.

[opt_def -basic]
Following options are for configuring the Basic authentication
scheme parameters. See [sectref "Basic Authentication"].
To unset the proxy authentication information retained from a previous
call of this function either "--" or no additional parameters can be
supplied. This will remove the existing authentication information.

[list_end]

[section "Basic Authentication"]

Basic is the simplest and most commonly use HTTP proxy authentication
scheme. It is described in (1 section 11) and also in (2). It offers

The following options exists for this scheme:
[list_begin options]
[opt_def "-username" "name"]
The username required to authenticate with the configured proxy.
[opt_def "-password" "password"]
The password required for the username specified.
[opt_def "-realm" "realm"]
This option is not used by this package but may be used in requesting
authentication details from the user.
[opt_def "--"]
The end-of-options indicator may be used alone to unset any
authentication details currently enabled.

[list_end]

[section "EXAMPLES"]

[para]
[example {
package require autoproxy

# autoproxy.tcl - Copyright (C) 2002-2008, 2017 Pat Thoyts <[email protected]>
#
# On Unix the standard for identifying the local HTTP proxy server
# seems to be to use the environment variable http_proxy or ftp_proxy and
# no_proxy to list those domains to be excluded from proxying.
#
# On Windows we can retrieve the Internet Settings values from the registry
# to obtain pretty much the same information.

    variable options
    array set opts {user {} passwd {} realm {}}
    foreach {opt value} $arglist {
        switch -glob -- $opt {
            -u* { set opts(user) $value}
            -p* { set opts(passwd) $value}
            -r* { set opts(realm) $value}
            --  { break }
            default {
                return -code error "invalid option \"$opt\": must be one of\
                     -username or -password or -realm"
            }
        }
    }

    # If nothing was provided, try calling the authProc
    if {$options(authProc) != {} \
            && ($opts(user) == {} || $opts(passwd) == {})} {
        set r [$options(authProc) $opts(user) $opts(passwd) $opts(realm)]
        set opts(user) [lindex $r 0]
        set opts(passwd) [lindex $r 1]
    }

    if {$opts(user) eq ""} {
        set options(basic) ""
    } else {
        # Store the encoded string to avoid re-encoding all the time.
        set options(basic) [list "Proxy-Authorization" \
                                [concat "Basic" \
                                     [base64::encode $opts(user):$opts(passwd)]]]
    }
    return
}

# -------------------------------------------------------------------------
# Description:
#  An http package proxy filter. This attempts to work out if a request
#  should go via the configured proxy using a glob comparison against the

    set state(tls_status) [tls::status $s]

    return $s
}

# -------------------------------------------------------------------------

package provide autoproxy 1.6

# -------------------------------------------------------------------------
#
# Local variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End:

source [file join \
            [file dirname [file dirname [file join [pwd] [info script]]]] \
            devtools testutilities.tcl]

testsNeedTcl  8.2
testsNeedTcltest 2.0

# uri and base64

testing {
    useLocal autoproxy.tcl autoproxy
}

# Clear the autoproxy package state for each test
proc packageReset {} {
    array set ::autoproxy::options {
        authProc "" basic "" no_proxy "" proxy_host "" proxy_port ""
    }
}

test autoproxy-1.0.0 "autoproxy::init standard" -setup {
    packageReset
} -body {
    autoproxy::init http://localhost:13128 "hosta,hostb"
    list [autoproxy::cget -host] \
        [autoproxy::cget -port] \
        [autoproxy::cget -no_proxy]
} -result {localhost 13128 {hosta hostb}}

test autoproxy-1.0.1 "autoproxy::init standard, auth" -setup {
    packageReset
} -body {
    autoproxy::init http://user:secret@localhost:13128 "hosta,hostb"
    list [autoproxy::cget -host] \
        [autoproxy::cget -port] \
        [autoproxy::cget -no_proxy] \
        [base64::decode [lindex [autoproxy::cget -basic] 1 1]]
} -result {localhost 13128 {hosta hostb} user:secret}

test autoproxy-1.0.2 "autoproxy::init standard, override" -setup {
    packageReset
} -body {
    autoproxy::init http://proxyone:13128 "hosta,hostb"
    autoproxy::init http://proxytwo:13129 "hostc,hostd"
    list [autoproxy::cget -host] \
        [autoproxy::cget -port] \
        [autoproxy::cget -no_proxy]
} -result {proxytwo 13129 {hostc hostd}}

test autoproxy-1.0.3 "autoproxy::init standard, auth, override" -setup {
    packageReset
} -body {
    autoproxy::init http://user:secret@localhost:13128 "hosta,hostb"
    autoproxy::init http://luser:passwd@proxy:13129 "hostc,hostd"
    list [autoproxy::cget -host] \
        [autoproxy::cget -port] \
        [autoproxy::cget -no_proxy] \
        [base64::decode [lindex [autoproxy::cget -basic] 1 1]]
} -result {proxy 13129 {hostc hostd} luser:passwd}

test autoproxy-1.0.4 "autoproxy::init standard, colons" -setup {
    packageReset
} -body {
    autoproxy::init http://localhost:13128 "hosta;hostb"
    list [autoproxy::cget -host] \
        [autoproxy::cget -port] \
        [autoproxy::cget -no_proxy]
} -result {localhost 13128 {hosta hostb}}

test autoproxy-1.1.0 "autoproxy::configure -host" -setup {
    packageReset
} -body {
    autoproxy::configure -host proxyhost
    autoproxy::cget -host
} -result {proxyhost}

test autoproxy-1.1.1 "autoproxy::configure -port" -setup {
    packageReset
} -body {
    autoproxy::configure -port 3128
    autoproxy::cget -port
} -result {3128}

test autoproxy-1.1.2 "autoproxy::configure -proxy_host" -setup {
    packageReset
} -body {
    autoproxy::configure -proxy_host proxyhost
    autoproxy::cget -proxy_host
} -result {proxyhost}

test autoproxy-1.1.3 "autoproxy::configure -proxy_port" -setup {
    packageReset
} -body {
    autoproxy::configure -proxy_port 3128
    autoproxy::cget -proxy_port
} -result {3128}

test autoproxy-1.1.4 "autoproxy::configure -no_proxy" -setup {
    packageReset
} -body {
    autoproxy::configure -no_proxy "localhost otherhost"
    autoproxy::cget -no_proxy
} -result {localhost otherhost}

test autoproxy-1.1.5 "autoproxy::configure -no_proxy override" -setup {
    packageReset
} -body {
    autoproxy::configure -no_proxy "localhost otherhost"
    autoproxy::configure -no_proxy "althost"
    autoproxy::cget -no_proxy
} -result {althost}

test autoproxy-1.1.6 "autoproxy::configure -authProc" -setup {
    packageReset
} -body {
    autoproxy::configure -authProc my_auth_proc
    autoproxy::cget -authProc
} -result {my_auth_proc}

test autoproxy-1.2.0 "autoproxy::configure -basic set details" -setup {
    packageReset
} -body {
    autoproxy::configure -basic -user test -password secret -realm tcllib
    autoproxy::cget -basic
} -result {Proxy-Authorization {Basic dGVzdDpzZWNyZXQ=}}

test autoproxy-1.2.1 "autoproxy::configure -basic confirm encoding" -setup {
    packageReset
} -body {
    autoproxy::configure -basic -user test -password secret -realm tcllib
    base64::decode [lindex [autoproxy::cget -basic] 1 1]
} -result {test:secret}

test autoproxy-1.2.2 "autoproxy::configure -basic reset" -setup {
    packageReset
    autoproxy::configure -basic -user test -password secret -realm tcllib
} -body {
    autoproxy::configure -basic --
    autoproxy::cget -basic
} -result {}

test autoproxy-1.2.3 "autoproxy::configure -basic reset (2)" -setup {
    packageReset
    autoproxy::configure -basic -user test -password secret -realm tcllib
} -body {
    autoproxy::configure -basic
    autoproxy::cget -basic
} -result {}

testsuiteCleanup

# Local variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End:

if {![package vsatisfies [package provide Tcl] 8.2]} {return}
package ifneeded autoproxy 1.6 [list source [file join $dir autoproxy.tcl]]

    dialog::shutdown
    dialog::setup server {Pop3 Fake Server} 1

    tls::init \
	-keyfile  [tcllibPath devtools/receiver.key] \
	-certfile [tcllibPath devtools/receiver.crt] \
	-cafile   [tcllibPath devtools/ca.crt] \
	-ssl2 0    \
	-ssl3 0    \
	-tls1 1    \
	-require 1

    dialog::dialog_set loginStatusOk
    set psock [pop3::open -socketcmd tls::socket localhost ak smash [dialog::listener]]
    close $psock
    dialog::waitdone
    set msg [string match sock* $psock]