diff -Naur wikit.vfs.orig/lib/autoproxy/autoproxy.tcl wikit.vfs/lib/autoproxy/autoproxy.tcl --- wikit.vfs.orig/lib/autoproxy/autoproxy.tcl Thu Jan 1 03:00:00 1970 +++ wikit.vfs/lib/autoproxy/autoproxy.tcl Wed Oct 6 05:35:21 2004 @@ -0,0 +1,315 @@ +# autoproxy.tcl - Copyright (C) 2002 Pat Thoyts +# +# 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. +# +# With this information we can setup a suitable filter procedure for the +# Tcl http package and arrange for automatic use of the proxy. +# +# Example: +# package require autoproxy +# autoproxy::init +# set tok [http::geturl http://wiki.tcl.tk/] +# http::data $tok +# +# @(#)$Id: autoproxy.tcl,v 1.3 2004/07/19 13:40:18 patthoyts Exp $ + +package require http; # tcl +package require uri; # tcllib +package require base64; # tcllib + +namespace eval ::autoproxy { + variable rcsid {$Id: autoproxy.tcl,v 1.3 2004/07/19 13:40:18 patthoyts Exp $} + variable version 1.2.0 + variable options + + if {! [info exists options]} { + array set options { + proxy_host "" + proxy_port 80 + no_proxy {} + basic {} + authProc {} + } + } + + variable winregkey + set winregkey [join { + HKEY_CURRENT_USER + Software Microsoft Windows + CurrentVersion "Internet Settings" + } \\] +} + +# ------------------------------------------------------------------------- +# Description: +# Obtain configuration options for the server. +# +proc ::autoproxy::cget {option} { + variable options + switch -glob -- $option] { + -host - + -proxy_h* { set options(proxy_host) } + -port - + -proxy_p* { set options(proxy_port) } + -no* { set options(no_proxy) } + -basic { set options(basic) } + -authProc { set options(authProc) } + default { + set err [join [lsort [array names options]] ", -"] + return -code error "bad option \"$option\":\ + must be one of -$err" + } + } +} + +# ------------------------------------------------------------------------- +# Description: +# Configure the autoproxy package settings. +# You may only configure one type of authorisation at a time as once we hit +# -basic, -digest or -ntlm - all further args are passed to the protocol +# specific script. +# +# Of course, most of the point of this package is to fill as many of these +# fields as possible automatically. You should call autoproxy::init to +# do automatic configuration and then call this method to refine the details. +# +proc ::autoproxy::configure {args} { + variable options + + if {[llength $args] == 0} { + foreach {opt value} [array get options] { + lappend r -$opt $value + } + return $r + } + + while {[string match "-*" [set option [lindex $args 0]]]} { + switch -glob -- $option { + -host - + -proxy_h* { set options(proxy_host) [Pop args 1]} + -port - + -proxy_p* { set options(proxy_port) [Pop args 1]} + -no* { set options(no_proxy) [Pop args 1] } + -basic { Pop args; configure:basic $args ; break } + -authProc { set options(authProc) [Pop args] } + -- { Pop args; break } + default { + set opts [join [lsort [array names options]] ", -"] + return -code error "bad option \"$option\":\ + must be one of -$opts" + } + } + Pop args + } +} + +# ------------------------------------------------------------------------- +# Description: +# Initialise the http proxy information from the environment or the +# registry (Win32) +# +# This procedure will load the http package and re-writes the +# http::geturl method to add in the authorisation header. +# +# A better solution will be to arrange for the http package to request the +# authorisation key on receiving an authorisation reqest. +# +proc ::autoproxy::init {} { + global tcl_platform + global env + variable winregkey + variable options + set no_proxy {} + set httpproxy {} + + # Look for standard environment variables. + if {[info exists env(http_proxy)]} { + set httpproxy $env(http_proxy) + if {[info exists env(no_proxy)]} { + set no_proxy $env(no_proxy) + } + } else { + if {$tcl_platform(platform) == "windows"} { + package require registry 1.0 + array set reg {ProxyEnable 0 ProxyServer "" ProxyOverride {}} + catch { + # IE5 changed ProxyEnable from a binary to a dword value. + switch -exact -- [registry type $winregkey "ProxyEnable"] { + dword { + set reg(ProxyEnable) [registry get $winregkey "ProxyEnable"] + } + binary { + set v [registry get $winregkey "ProxyEnable"] + binary scan $v i reg(ProxyEnable) + } + default { + return -code error "unexpected type found for\ + ProxyEnable registry item" + } + } + set reg(ProxyServer) [registry get $winregkey "ProxyServer"] + set reg(ProxyOverride) [registry get $winregkey "ProxyOverride"] + } + if {![string is bool $reg(ProxyEnable)]} { + set reg(ProxyEnable) 0 + } + if {$reg(ProxyEnable)} { + set httpproxy $reg(ProxyServer) + set no_proxy $reg(ProxyOverride) + } + } + } + + # If we found something ... + if {$httpproxy != {}} { + # The http_proxy is supposed to be a URL - lets make sure. + if {![regexp {\w://.*} $httpproxy]} { + set httpproxy "http://$httpproxy" + } + + # decompose the string. + array set proxy [uri::split $httpproxy] + + # turn the no_proxy value into a tcl list + set no_proxy [string map {; " " , " "} $no_proxy] + + # configure ourselves + configure -proxy_host $proxy(host) \ + -proxy_port $proxy(port) \ + -no_proxy $no_proxy + + # Lift the authentication details from the environment if present. + if {[string length $proxy(user)] < 1 \ + && [info exists env(http_proxy_user)] \ + && [info exists env(http_proxy_pass)]} { + set proxy(user) $env(http_proxy_user) + set proxy(pwd) $env(http_proxy_pass) + } + + # Maybe the proxy url has authentication parameters? + # At this time, only Basic is supported. + if {[string length $proxy(user)] > 0} { + configure -basic -username $proxy(user) -password $proxy(pwd) + } + + # setup and configure the http package to use our proxy info. + http::config -proxyfilter [namespace origin filter] + } + return $httpproxy +} + +# ------------------------------------------------------------------------- +# Description: +# Pop the nth element off a list. Used in options processing. +proc ::autoproxy::Pop {varname {nth 0}} { + upvar $varname args + set r [lindex $args $nth] + set args [lreplace $args $nth $nth] + return $r +} + +# ------------------------------------------------------------------------- +# Description +# An example user authentication procedure. +# Returns: +# A two element list consisting of the users authentication id and +# password. +proc ::autoproxy::defAuthProc {{user {}} {passwd {}} {realm {}}} { + package require BWidget + if {[string length $realm] > 0} { + set title "Realm: $realm" + } else { + set title {} + } + return [PasswdDlg .defAuthDlg -parent {} -transient 0 -title $title \ + -logintext $user -passwdtext $passwd] +} + +# ------------------------------------------------------------------------- + +# Description: +# Implement support for the Basic authentication scheme (RFC 1945,2617). +# Options: +# -user userid - pass in the user ID (May require Windows NT domain +# as DOMAIN\\username) +# -password pwd - pass in the user's password. +# -realm realm - pass in the http realm. +# +proc ::autoproxy::configure:basic {arglist} { + 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} + 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] + } + + # 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 is a request +# should go via the configured proxy using a glob comparison against the +# no_proxy list items. A typical no_proxy list might be +# [list localhost *.my.domain.com 127.0.0.1] +# +# If we are going to use the proxy - then insert the proxy authorization +# header. +# +proc ::autoproxy::filter {host} { + variable options + + if {$options(proxy_host) == {}} { + return {} + } + + foreach domain $options(no_proxy) { + if {[string match $domain $host]} { + return {} + } + } + + # Add authorisation header to the request (by Anders Ramdahl) + catch { + upvar state State + if {$options(basic) != {}} { + set State(-headers) [concat $options(basic) $State(-headers)] + } + } + return [list $options(proxy_host) $options(proxy_port)] +} + +# ------------------------------------------------------------------------- + +package provide autoproxy $::autoproxy::version + +# ------------------------------------------------------------------------- +# +# Local variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff -Naur wikit.vfs.orig/lib/autoproxy/pkgIndex.tcl wikit.vfs/lib/autoproxy/pkgIndex.tcl --- wikit.vfs.orig/lib/autoproxy/pkgIndex.tcl Thu Jan 1 03:00:00 1970 +++ wikit.vfs/lib/autoproxy/pkgIndex.tcl Wed Oct 6 05:35:21 2004 @@ -0,0 +1,6 @@ +# pkgIndex.tcl for the tcllib http module. +# +# $Id: pkgIndex.tcl,v 1.2 2004/07/19 13:40:18 patthoyts Exp $ + +if {![package vsatisfies [package provide Tcl] 8.2]} {return} +package ifneeded autoproxy 1.2.0 [list source [file join $dir autoproxy.tcl]] diff -Naur wikit.vfs.orig/lib/base64/base64.tcl wikit.vfs/lib/base64/base64.tcl --- wikit.vfs.orig/lib/base64/base64.tcl Thu Jan 1 03:00:00 1970 +++ wikit.vfs/lib/base64/base64.tcl Wed Oct 6 05:35:21 2004 @@ -0,0 +1,325 @@ +# base64.tcl -- +# +# Encode/Decode base64 for a string +# Stephen Uhler / Brent Welch (c) 1997 Sun Microsystems +# The decoder was done for exmh by Chris Garrigues +# +# Copyright (c) 1998-2000 by Ajuba Solutions. +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id$ + +# Version 1.0 implemented Base64_Encode, Base64_Decode +# Version 2.0 uses the base64 namespace +# Version 2.1 fixes various decode bugs and adds options to encode +# Version 2.2 is much faster, Tcl8.0 compatible +# Version 2.2.1 bugfixes +# Version 2.2.2 bugfixes +# Version 2.3 bugfixes and extended to support Trf + +package require Tcl 8.2 +namespace eval ::base64 { + namespace export encode decode +} + +if {![catch {package require Trf 2.0}]} { + # Trf is available, so implement the functionality provided here + # in terms of calls to Trf for speed. + + # ::base64::encode -- + # + # Base64 encode a given string. + # + # Arguments: + # args ?-maxlen maxlen? ?-wrapchar wrapchar? string + # + # If maxlen is 0, the output is not wrapped. + # + # Results: + # A Base64 encoded version of $string, wrapped at $maxlen characters + # by $wrapchar. + + proc ::base64::encode {args} { + # Set the default wrapchar and maximum line length to match the output + # of GNU uuencode 4.2. Various RFCs allow for different wrapping + # characters and wraplengths, so these may be overridden by command line + # options. + set wrapchar "\n" + set maxlen 60 + + if { [llength $args] == 0 } { + error "wrong # args: should be \"[lindex [info level 0] 0]\ + ?-maxlen maxlen? ?-wrapchar wrapchar? string\"" + } + + set optionStrings [list "-maxlen" "-wrapchar"] + for {set i 0} {$i < [llength $args] - 1} {incr i} { + set arg [lindex $args $i] + set index [lsearch -glob $optionStrings "${arg}*"] + if { $index == -1 } { + error "unknown option \"$arg\": must be -maxlen or -wrapchar" + } + incr i + if { $i >= [llength $args] - 1 } { + error "value for \"$arg\" missing" + } + set val [lindex $args $i] + + # The name of the variable to assign the value to is extracted + # from the list of known options, all of which have an + # associated variable of the same name as the option without + # a leading "-". The [string range] command is used to strip + # of the leading "-" from the name of the option. + # + # FRINK: nocheck + set [string range [lindex $optionStrings $index] 1 end] $val + } + + # [string is] requires Tcl8.2; this works with 8.0 too + if {[catch {expr {$maxlen % 2}}]} { + error "expected integer but got \"$maxlen\"" + } + + set string [lindex $args end] + set result [::base64 -mode encode -- $string] + set result [string map [list \n ""] $result] + + if {$maxlen > 0} { + set res "" + set edge [expr {$maxlen - 1}] + while {[string length $result] > $maxlen} { + append res [string range $result 0 $edge]$wrapchar + set result [string range $result $maxlen end] + } + if {[string length $result] > 0} { + append res $result + } + set result $res + } + + return $result + } + + # ::base64::decode -- + # + # Base64 decode a given string. + # + # Arguments: + # string The string to decode. Characters not in the base64 + # alphabet are ignored (e.g., newlines) + # + # Results: + # The decoded value. + + proc ::base64::decode {string} { + regsub -all {\s} $string {} string + ::base64 -mode decode -- $string + } + +} else { + # Without Trf use a pure tcl implementation + + namespace eval base64 { + variable base64 {} + variable base64_en {} + + # We create the auxiliary array base64_tmp, it will be unset later. + + set i 0 + foreach char {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z \ + a b c d e f g h i j k l m n o p q r s t u v w x y z \ + 0 1 2 3 4 5 6 7 8 9 + /} { + set base64_tmp($char) $i + lappend base64_en $char + incr i + } + + # + # Create base64 as list: to code for instance C<->3, specify + # that [lindex $base64 67] be 3 (C is 67 in ascii); non-coded + # ascii chars get a {}. we later use the fact that lindex on a + # non-existing index returns {}, and that [expr {} < 0] is true + # + + # the last ascii char is 'z' + scan z %c len + for {set i 0} {$i <= $len} {incr i} { + set char [format %c $i] + set val {} + if {[info exists base64_tmp($char)]} { + set val $base64_tmp($char) + } else { + set val {} + } + lappend base64 $val + } + + # code the character "=" as -1; used to signal end of message + scan = %c i + set base64 [lreplace $base64 $i $i -1] + + # remove unneeded variables + unset base64_tmp i char len val + + namespace export encode decode + } + + # ::base64::encode -- + # + # Base64 encode a given string. + # + # Arguments: + # args ?-maxlen maxlen? ?-wrapchar wrapchar? string + # + # If maxlen is 0, the output is not wrapped. + # + # Results: + # A Base64 encoded version of $string, wrapped at $maxlen characters + # by $wrapchar. + + proc ::base64::encode {args} { + set base64_en $::base64::base64_en + + # Set the default wrapchar and maximum line length to match the output + # of GNU uuencode 4.2. Various RFCs allow for different wrapping + # characters and wraplengths, so these may be overridden by command line + # options. + set wrapchar "\n" + set maxlen 60 + + if { [llength $args] == 0 } { + error "wrong # args: should be \"[lindex [info level 0] 0]\ + ?-maxlen maxlen? ?-wrapchar wrapchar? string\"" + } + + set optionStrings [list "-maxlen" "-wrapchar"] + for {set i 0} {$i < [llength $args] - 1} {incr i} { + set arg [lindex $args $i] + set index [lsearch -glob $optionStrings "${arg}*"] + if { $index == -1 } { + error "unknown option \"$arg\": must be -maxlen or -wrapchar" + } + incr i + if { $i >= [llength $args] - 1 } { + error "value for \"$arg\" missing" + } + set val [lindex $args $i] + + # The name of the variable to assign the value to is extracted + # from the list of known options, all of which have an + # associated variable of the same name as the option without + # a leading "-". The [string range] command is used to strip + # of the leading "-" from the name of the option. + # + # FRINK: nocheck + set [string range [lindex $optionStrings $index] 1 end] $val + } + + # [string is] requires Tcl8.2; this works with 8.0 too + if {[catch {expr {$maxlen % 2}}]} { + error "expected integer but got \"$maxlen\"" + } + + set string [lindex $args end] + + set result {} + set state 0 + set length 0 + + + # Process the input bytes 3-by-3 + + binary scan $string c* X + foreach {x y z} $X { + # Do the line length check before appending so that we don't get an + # extra newline if the output is a multiple of $maxlen chars long. + if {$maxlen && $length >= $maxlen} { + append result $wrapchar + set length 0 + } + + append result [lindex $base64_en [expr {($x >>2) & 0x3F}]] + if {$y != {}} { + append result [lindex $base64_en [expr {(($x << 4) & 0x30) | (($y >> 4) & 0xF)}]] + if {$z != {}} { + append result \ + [lindex $base64_en [expr {(($y << 2) & 0x3C) | (($z >> 6) & 0x3)}]] + append result [lindex $base64_en [expr {($z & 0x3F)}]] + } else { + set state 2 + break + } + } else { + set state 1 + break + } + incr length 4 + } + if {$state == 1} { + append result [lindex $base64_en [expr {(($x << 4) & 0x30)}]]== + } elseif {$state == 2} { + append result [lindex $base64_en [expr {(($y << 2) & 0x3C)}]]= + } + return $result + } + + # ::base64::decode -- + # + # Base64 decode a given string. + # + # Arguments: + # string The string to decode. Characters not in the base64 + # alphabet are ignored (e.g., newlines) + # + # Results: + # The decoded value. + + proc ::base64::decode {string} { + if {[string length $string] == 0} {return ""} + + set base64 $::base64::base64 + set output "" ; # Fix for [Bug 821126] + + binary scan $string c* X + foreach x $X { + set bits [lindex $base64 $x] + if {$bits >= 0} { + if {[llength [lappend nums $bits]] == 4} { + foreach {v w z y} $nums break + set a [expr {($v << 2) | ($w >> 4)}] + set b [expr {(($w & 0xF) << 4) | ($z >> 2)}] + set c [expr {(($z & 0x3) << 6) | $y}] + append output [binary format ccc $a $b $c] + set nums {} + } + } elseif {$bits == -1} { + # = indicates end of data. Output whatever chars are left. + # The encoding algorithm dictates that we can only have 1 or 2 + # padding characters. If x=={}, we have 12 bits of input + # (enough for 1 8-bit output). If x!={}, we have 18 bits of + # input (enough for 2 8-bit outputs). + + foreach {v w z} $nums break + set a [expr {($v << 2) | (($w & 0x30) >> 4)}] + + if {$z == {}} { + append output [binary format c $a ] + } else { + set b [expr {(($w & 0xF) << 4) | (($z & 0x3C) >> 2)}] + append output [binary format cc $a $b] + } + break + } else { + # RFC 2045 says that line breaks and other characters not part + # of the Base64 alphabet must be ignored, and that the decoder + # can optionally emit a warning or reject the message. We opt + # not to do so, but to just ignore the character. + continue + } + } + return $output + } +} + +package provide base64 2.3.1 diff -Naur wikit.vfs.orig/lib/base64/pkgIndex.tcl wikit.vfs/lib/base64/pkgIndex.tcl --- wikit.vfs.orig/lib/base64/pkgIndex.tcl Thu Jan 1 03:00:00 1970 +++ wikit.vfs/lib/base64/pkgIndex.tcl Wed Dec 1 09:59:26 2004 @@ -0,0 +1 @@ +package ifneeded base64 2.3.1 [list source [file join $dir base64.tcl]] diff -Naur wikit.vfs.orig/lib/uri/pkgIndex.tcl wikit.vfs/lib/uri/pkgIndex.tcl --- wikit.vfs.orig/lib/uri/pkgIndex.tcl Thu Jan 1 03:00:00 1970 +++ wikit.vfs/lib/uri/pkgIndex.tcl Wed Dec 1 10:02:04 2004 @@ -0,0 +1,2 @@ +package ifneeded uri 1.1.4 [list source [file join $dir uri.tcl]] +package ifneeded uri::urn 1.0.2 [list source [file join $dir urn-scheme.tcl]] diff -Naur wikit.vfs.orig/lib/uri/uri.tcl wikit.vfs/lib/uri/uri.tcl --- wikit.vfs.orig/lib/uri/uri.tcl Thu Jan 1 03:00:00 1970 +++ wikit.vfs/lib/uri/uri.tcl Wed Oct 6 05:35:22 2004 @@ -0,0 +1,932 @@ +# uri.tcl -- +# +# URI parsing and fetch +# +# Copyright (c) 2000 Zveno Pty Ltd +# Steve Ball, http://www.zveno.com/ +# Derived from urls.tcl by Andreas Kupries +# +# TODO: +# Handle www-url-encoding details +# +# CVS: $Id: uri.tcl,v 1.27 2004/05/03 22:56:25 andreas_kupries Exp $ + +package require Tcl 8.2 + +namespace eval ::uri { + + namespace export split join + namespace export resolve isrelative + namespace export geturl + namespace export canonicalize + namespace export register + + variable file:counter 0 + + # extend these variable in the coming namespaces + variable schemes {} + variable schemePattern "" + variable url "" + variable url2part + array set url2part {} + + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # basic regular expressions used in URL syntax. + + namespace eval basic { + variable loAlpha {[a-z]} + variable hiAlpha {[A-Z]} + variable digit {[0-9]} + variable alpha {[a-zA-Z]} + variable safe {[$_.+-]} + variable extra {[!*'(,)]} + # danger in next pattern, order important for [] + variable national {[][|\}\{\^~`]} + variable punctuation {[<>#%"]} ;#" fake emacs hilit + variable reserved {[;/?:@&=]} + variable hex {[0-9A-Fa-f]} + variable alphaDigit {[A-Za-z0-9]} + variable alphaDigitMinus {[A-Za-z0-9-]} + + # next is + variable unsafe {[][<>"#%\{\}|\\^~`]} ;#" emacs hilit + variable escape "%${hex}${hex}" + + # unreserved = alpha | digit | safe | extra + # xchar = unreserved | reserved | escape + + variable unreserved {[a-zA-Z0-9$_.+!*'(,)-]} + variable uChar "(${unreserved}|${escape})" + variable xCharN {[a-zA-Z0-9$_.+!*'(,);/?:@&=-]} + variable xChar "(${xCharN}|${escape})" + variable digits "${digit}+" + + variable toplabel \ + "(${alpha}${alphaDigitMinus}*${alphaDigit}|${alpha})" + variable domainlabel \ + "(${alphaDigit}${alphaDigitMinus}*${alphaDigit}|${alphaDigit})" + + variable hostname \ + "((${domainlabel}\\.)*${toplabel})" + variable hostnumber \ + "(${digits}\\.${digits}\\.${digits}\\.${digits})" + + variable host "(${hostname}|${hostnumber})" + + variable port $digits + variable hostOrPort "${host}(:${port})?" + + variable usrCharN {[a-zA-Z0-9$_.+!*'(,);?&=-]} + variable usrChar "(${usrCharN}|${escape})" + variable user "${usrChar}*" + variable password $user + variable login "(${user}(:${password})?@)?${hostOrPort}" + } ;# basic {} +} + + +# ::uri::register -- +# +# Register a scheme (and aliases) in the package. The command +# creates a namespace below "::uri" with the same name as the +# scheme and executes the script declaring the pattern variables +# for this scheme in the new namespace. At last it updates the +# uri variables keeping track of overall scheme information. +# +# The script has to declare at least the variable "schemepart", +# the pattern for an url of the registered scheme after the +# scheme declaration. Not declaring this variable is an error. +# +# Arguments: +# schemeList Name of the scheme to register, plus aliases +# script Script declaring the scheme patterns +# +# Results: +# None. + +proc ::uri::register {schemeList script} { + variable schemes + variable schemePattern + variable url + variable url2part + + # Check scheme and its aliases for existence. + foreach scheme $schemeList { + if {[lsearch -exact $schemes $scheme] >= 0} { + return -code error \ + "trying to register scheme (\"$scheme\") which is already known" + } + } + + # Get the main scheme + set scheme [lindex $schemeList 0] + + if {[catch {namespace eval $scheme $script} msg]} { + catch {namespace delete $scheme} + return -code error \ + "error while evaluating scheme script: $msg" + } + + if {![info exists ${scheme}::schemepart]} { + namespace delete $scheme + return -code error \ + "Variable \"schemepart\" is missing." + } + + # Now we can extend the variables which keep track of the registered schemes. + + eval [linsert $schemeList 0 lappend schemes] + set schemePattern "([::join $schemes |]):" + + foreach s schemeList { + # FRINK: nocheck + set url2part($s) "${s}:[set ${scheme}::schemepart]" + # FRINK: nocheck + append url "(${s}:[set ${scheme}::schemepart])|" + } + set url [string trimright $url |] + return +} + +# ::uri::split -- +# +# Splits the given into its constituents. +# +# Arguments: +# url the URL to split +# +# Results: +# Tcl list containing constituents, suitable for 'array set'. + +proc ::uri::split {url {defaultscheme http}} { + + set url [string trim $url] + set scheme {} + + # RFC 1738: scheme = 1*[ lowalpha | digit | "+" | "-" | "." ] + regexp -- {^([a-z0-9+.-][a-z0-9+.-]*):} $url dummy scheme + + if {$scheme == {}} { + set scheme $defaultscheme + } + + # ease maintenance: dynamic dispatch, able to handle all schemes + # added in future! + + if {[::info procs Split[string totitle $scheme]] == {}} { + error "unknown scheme '$scheme' in '$url'" + } + + regsub -- "^${scheme}:" $url {} url + + set parts(scheme) $scheme + array set parts [Split[string totitle $scheme] $url] + + # should decode all encoded characters! + + return [array get parts] +} + +proc ::uri::SplitFtp {url} { + # @c Splits the given ftp- into its constituents. + # @a url: The url to split, without! scheme specification. + # @r List containing the constituents, suitable for 'array set'. + + # general syntax: + # //:@://...//;type= + # + # additional rules: + # + # : are optional, detectable by presence of @. + # is optional too. + # + # "//" [ [":" ] "@"] [":" ] "/" + # "/" ..."/" "/" [";type=" ] + + upvar \#0 [namespace current]::ftp::typepart ftptype + + array set parts {user {} pwd {} host {} port {} path {} type {}} + + # slash off possible type specification + + if {[regexp -indices -- "${ftptype}$" $url dummy ftype]} { + + set from [lindex $ftype 0] + set to [lindex $ftype 1] + + set parts(type) [string range $url $from $to] + + set from [lindex $dummy 0] + set url [string replace $url $from end] + } + + # Handle user, password, host and port + + if {[string match "//*" $url]} { + set url [string range $url 2 end] + + array set parts [GetUPHP url] + } + + set parts(path) [string trimleft $url /] + + return [array get parts] +} + +proc ::uri::JoinFtp args { + array set components { + user {} pwd {} host {} port {} + path {} type {} + } + array set components $args + + set userPwd {} + if {[string length $components(user)] || [string length $components(pwd)]} { + set userPwd $components(user)[expr {[string length $components(pwd)] ? ":$components(pwd)" : {}}]@ + } + + set port {} + if {[string length $components(port)]} { + set port :$components(port) + } + + set type {} + if {[string length $components(type)]} { + set type \;type=$components(type) + } + + return ftp://${userPwd}$components(host)${port}/[string trimleft $components(path) /]$type +} + +proc ::uri::SplitHttps {url} { + uri::SplitHttp $url +} + +proc ::uri::SplitHttp {url} { + # @c Splits the given http- into its constituents. + # @a url: The url to split, without! scheme specification. + # @r List containing the constituents, suitable for 'array set'. + + # general syntax: + # //:/? + # + # where and are as described in Section 3.1. If : + # is omitted, the port defaults to 80. No user name or password is + # allowed. is an HTTP selector, and is a query + # string. The is optional, as is the and its + # preceding "?". If neither nor is present, the "/" + # may also be omitted. + # + # Within the and components, "/", ";", "?" are + # reserved. The "/" character may be used within HTTP to designate a + # hierarchical structure. + # + # path == "/" ..."/" "/" ["#" ] + + upvar #0 [namespace current]::http::search search + upvar #0 [namespace current]::http::segment segment + + array set parts {host {} port {} path {} query {}} + + set searchPattern "\\?(${search})\$" + set fragmentPattern "#(${segment})\$" + + # slash off possible query + + if {[regexp -indices -- $searchPattern $url match query]} { + set from [lindex $query 0] + set to [lindex $query 1] + + set parts(query) [string range $url $from $to] + + set url [string replace $url [lindex $match 0] end] + } + + # slash off possible fragment + + if {[regexp -indices -- $fragmentPattern $url match fragment]} { + set from [lindex $fragment 0] + set to [lindex $fragment 1] + + set parts(fragment) [string range $url $from $to] + + set url [string replace $url [lindex $match 0] end] + } + + if {[string match "//*" $url]} { + set url [string range $url 2 end] + + array set parts [GetUPHP url] + } + + set parts(path) [string trimleft $url /] + + return [array get parts] +} + +proc ::uri::JoinHttp {args} { + eval [linsert $args 0 uri::JoinHttpInner http 80] +} + +proc ::uri::JoinHttps {args} { + eval [linsert $args 0 uri::JoinHttpInner https 443] +} + +proc ::uri::JoinHttpInner {scheme defport args} { + array set components [list \ + host {} port $defport path {} query {} \ + ] + array set components $args + + set port {} + if {[string length $components(port)] && $components(port) != $defport} { + set port :$components(port) + } + + set query {} + if {[string length $components(query)]} { + set query ?$components(query) + } + + regsub -- {^/} $components(path) {} components(path) + + if { [info exists components(fragment)] && $components(fragment) != "" } { + set components(fragment) "#$components(fragment)" + } else { + set components(fragment) "" + } + + return $scheme://$components(host)$port/$components(path)$components(fragment)$query +} + +proc ::uri::SplitFile {url} { + # @c Splits the given file- into its constituents. + # @a url: The url to split, without! scheme specification. + # @r List containing the constituents, suitable for 'array set'. + + upvar #0 [namespace current]::basic::hostname hostname + upvar #0 [namespace current]::basic::hostnumber hostnumber + + if {[string match "//*" $url]} { + set url [string range $url 2 end] + + set hostPattern "^($hostname|$hostnumber)" + switch -exact -- $::tcl_platform(platform) { + windows { + # Catch drive letter + append hostPattern :? + } + default { + # Proceed as usual + } + } + + if {[regexp -indices -- $hostPattern $url match host]} { + set fh [lindex $host 0] + set th [lindex $host 1] + + set parts(host) [string range $url $fh $th] + + set matchEnd [lindex $match 1] + incr matchEnd + + set url [string range $url $matchEnd end] + } + } + + set parts(path) $url + + return [array get parts] +} + +proc ::uri::JoinFile args { + array set components { + host {} port {} path {} + } + array set components $args + + switch -exact -- $::tcl_platform(platform) { + windows { + if {[string length $components(host)]} { + return file://$components(host):$components(path) + } else { + return file://$components(path) + } + } + default { + return file://$components(host)$components(path) + } + } +} + +proc ::uri::SplitMailto {url} { + # @c Splits the given mailto- into its constituents. + # @a url: The url to split, without! scheme specification. + # @r List containing the constituents, suitable for 'array set'. + + if {[string match "*@*" $url]} { + set url [::split $url @] + return [list user [lindex $url 0] host [lindex $url 1]] + } else { + return [list user $url] + } +} + +proc ::uri::JoinMailto args { + array set components { + user {} host {} + } + array set components $args + + return mailto:$components(user)@$components(host) +} + +proc ::uri::SplitNews {url} { + if { [string first @ $url] >= 0 } { + return [list message-id $url] + } else { + return [list newsgroup-name $url] + } +} + +proc ::uri::JoinNews args { + array set components { + message-id {} newsgroup-name {} + } + array set components $args + return news:$components(message-id)$components(newsgroup-name) +} + +proc ::uri::GetUPHP {urlvar} { + # @c Parse user, password host and port out of the url stored in + # @c variable . + # @d Side effect: The extracted information is removed from the given url. + # @r List containing the extracted information in a format suitable for + # @r 'array set'. + # @a urlvar: Name of the variable containing the url to parse. + + upvar \#0 [namespace current]::basic::user user + upvar \#0 [namespace current]::basic::password password + upvar \#0 [namespace current]::basic::hostname hostname + upvar \#0 [namespace current]::basic::hostnumber hostnumber + upvar \#0 [namespace current]::basic::port port + + upvar $urlvar url + + array set parts {user {} pwd {} host {} port {}} + + # syntax + # "//" [ [":" ] "@"] [":" ] "/" + # "//" already cut off by caller + + set upPattern "^(${user})(:(${password}))?@" + + if {[regexp -indices -- $upPattern $url match theUser c d thePassword]} { + set fu [lindex $theUser 0] + set tu [lindex $theUser 1] + + set fp [lindex $thePassword 0] + set tp [lindex $thePassword 1] + + set parts(user) [string range $url $fu $tu] + set parts(pwd) [string range $url $fp $tp] + + set matchEnd [lindex $match 1] + incr matchEnd + + set url [string range $url $matchEnd end] + } + + set hpPattern "^($hostname|$hostnumber)(:($port))?" + + if {[regexp -indices -- $hpPattern $url match theHost c d e f g h thePort]} { + set fh [lindex $theHost 0] + set th [lindex $theHost 1] + + set fp [lindex $thePort 0] + set tp [lindex $thePort 1] + + set parts(host) [string range $url $fh $th] + set parts(port) [string range $url $fp $tp] + + set matchEnd [lindex $match 1] + incr matchEnd + + set url [string range $url $matchEnd end] + } + + return [array get parts] +} + +proc ::uri::GetHostPort {urlvar} { + # @c Parse host and port out of the url stored in variable . + # @d Side effect: The extracted information is removed from the given url. + # @r List containing the extracted information in a format suitable for + # @r 'array set'. + # @a urlvar: Name of the variable containing the url to parse. + + upvar #0 [namespace current]::basic::hostname hostname + upvar #0 [namespace current]::basic::hostnumber hostnumber + upvar #0 [namespace current]::basic::port port + + upvar $urlvar url + + set pattern "^(${hostname}|${hostnumber})(:(${port}))?" + + if {[regexp -indices -- $pattern $url match host c d e f g h thePort]} { + set fromHost [lindex $host 0] + set toHost [lindex $host 1] + + set fromPort [lindex $thePort 0] + set toPort [lindex $thePort 1] + + set parts(host) [string range $url $fromHost $toHost] + set parts(port) [string range $url $fromPort $toPort] + + set matchEnd [lindex $match 1] + incr matchEnd + + set url [string range $url $matchEnd end] + } + + return [array get parts] +} + +# ::uri::resolve -- +# +# Resolve an arbitrary URL, given a base URL +# +# Arguments: +# base base URL (absolute) +# url arbitrary URL +# +# Results: +# Returns a URL + +proc ::uri::resolve {base url} { + if {[string length $url]} { + if {[isrelative $url]} { + + array set baseparts [split $base] + + switch -- $baseparts(scheme) { + http - + https - + ftp - + file { + array set relparts [split $url] + if { [string match /* $url] } { + catch { set baseparts(path) $relparts(path) } + } elseif { [string match */ $baseparts(path)] } { + set baseparts(path) "$baseparts(path)$relparts(path)" + } else { + if { [string length $relparts(path)] > 0 } { + set path [lreplace [::split $baseparts(path) /] end end] + set baseparts(path) "[::join $path /]/$relparts(path)" + } + } + catch { set baseparts(query) $relparts(query) } + catch { set baseparts(fragment) $relparts(fragment) } + return [eval [linsert [array get baseparts] 0 join]] + } + default { + return -code error "unable to resolve relative URL \"$url\"" + } + } + + } else { + return $url + } + } else { + return $base + } +} + +# ::uri::isrelative -- +# +# Determines whether a URL is absolute or relative +# +# Arguments: +# url URL to check +# +# Results: +# Returns 1 if the URL is relative, 0 otherwise + +proc ::uri::isrelative url { + return [expr {![regexp -- {^[a-z0-9+-.][a-z0-9+-.]*:} $url]}] +} + +# ::uri::geturl -- +# +# Fetch the data from an arbitrary URL. +# +# This package provides a handler for the file: +# scheme, since this conflicts with the file command. +# +# Arguments: +# url address of data resource +# args configuration options +# +# Results: +# Depends on scheme + +proc ::uri::geturl {url args} { + array set urlparts [split $url] + + switch -- $urlparts(scheme) { + file { + return [eval [linsert $args 0 file_geturl $url]] + } + default { + # Load a geturl package for the scheme first and only if + # that fails the scheme package itself. This prevents + # cyclic dependencies between packages. + if {[catch {package require $urlparts(scheme)::geturl}]} { + package require $urlparts(scheme) + } + return [eval [linsert $args 0 $urlparts(scheme)::geturl $url]] + } + } +} + +# ::uri::file_geturl -- +# +# geturl implementation for file: scheme +# +# TODO: +# This is an initial, basic implementation. +# Eventually want to support all options for geturl. +# +# Arguments: +# url URL to fetch +# args configuration options +# +# Results: +# Returns data from file + +proc ::uri::file_geturl {url args} { + variable file:counter + + set var [namespace current]::file[incr file:counter] + upvar #0 $var state + array set state {data {}} + + array set parts [split $url] + + set ch [open $parts(path)] + # Could determine text/binary from file extension, + # except on Macintosh + # fconfigure $ch -translation binary + set state(data) [read $ch] + close $ch + + return $var +} + +# ::uri::join -- +# +# Format a URL +# +# Arguments: +# args components, key-value format +# +# Results: +# A URL + +proc ::uri::join args { + array set components $args + + return [eval [linsert $args 0 Join[string totitle $components(scheme)]]] +} + +# ::uri::canonicalize -- +# +# Canonicalize a URL +# +# Acknowledgements: +# Andreas Kupries +# +# Arguments: +# uri URI (which contains a path component) +# +# Results: +# The canonical form of the URI + +proc ::uri::canonicalize uri { + + # Make uri canonical with respect to dots (path changing commands) + # + # Remove single dots (.) => pwd not changing + # Remove double dots (..) => gobble previous segment of path + # + # Fixes for this command: + # + # * Ignore any url which cannot be split into components by this + # module. Just assume that such urls do not have a path to + # canonicalize. + # + # * Ignore any url which could be split into components, but does + # not have a path component. + # + # In the text above 'ignore' means + # 'return the url unchanged to the caller'. + + if {[catch {array set u [uri::split $uri]}]} { + return $uri + } + if {![info exists u(path)]} { + return $uri + } + + set uri $u(path) + + # Remove leading "./" "../" "/.." (and "/../") + regsub -all -- {^(\./)+} $uri {} uri + regsub -all -- {^/(\.\./)+} $uri {/} uri + regsub -all -- {^(\.\./)+} $uri {} uri + + # Remove inner /./ and /../ + while {[regsub -all -- {/\./} $uri {/} uri]} {} + while {[regsub -all -- {/[^/]+/\.\./} $uri {/} uri]} {} + while {[regsub -all -- {^[^/]+/\.\./} $uri {} uri]} {} + # Munge trailing /.. + while {[regsub -all -- {/[^/]+/\.\.} $uri {/} uri]} {} + if { $uri == ".." } { set uri "/" } + + set u(path) $uri + set uri [eval [linsert [array get u] 0 uri::join]] + + return $uri +} + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# regular expressions covering various url schemes + +# Currently known URL schemes: +# +# (RFC 1738) +# ------------------------------------------------ +# scheme basic syntax of scheme specific part +# ------------------------------------------------ +# ftp //:@://...//;type= +# +# http //:/? +# +# gopher //:/ +# %09 +# %09%09 +# +# mailto +# news +# +# nntp //:// +# telnet //:@:/ +# wais //:/ +# //:/? +# //:/// +# file /// +# prospero //:/;= +# ------------------------------------------------ +# +# (RFC 2111) +# ------------------------------------------------ +# scheme basic syntax of scheme specific part +# ------------------------------------------------ +# mid message-id +# message-id/content-id +# cid content-id +# ------------------------------------------------ + +# FTP +uri::register ftp { + variable escape [set [namespace parent [namespace current]]::basic::escape] + variable login [set [namespace parent [namespace current]]::basic::login] + + variable charN {[a-zA-Z0-9$_.+!*'(,)?:@&=-]} + variable char "(${charN}|${escape})" + variable segment "${char}*" + variable path "${segment}(/${segment})*" + + variable type {[AaDdIi]} + variable typepart ";type=(${type})" + variable schemepart \ + "//${login}(/${path}(${typepart})?)?" + + variable url "ftp:${schemepart}" +} + +# FILE +uri::register file { + variable host [set [namespace parent [namespace current]]::basic::host] + variable path [set [namespace parent [namespace current]]::ftp::path] + + variable schemepart "//(${host}|localhost)?/${path}" + variable url "file:${schemepart}" +} + +# HTTP +uri::register http { + variable escape \ + [set [namespace parent [namespace current]]::basic::escape] + variable hostOrPort \ + [set [namespace parent [namespace current]]::basic::hostOrPort] + + variable charN {[a-zA-Z0-9$_.+!*'(,);:@&=-]} + variable char "($charN|${escape})" + variable segment "${char}*" + + variable path "${segment}(/${segment})*" + variable search $segment + variable schemepart \ + "//${hostOrPort}(/${path}(\\?${search})?)?" + + variable url "http:${schemepart}" +} + +# GOPHER +uri::register gopher { + variable xChar \ + [set [namespace parent [namespace current]]::basic::xChar] + variable hostOrPort \ + [set [namespace parent [namespace current]]::basic::hostOrPort] + variable search \ + [set [namespace parent [namespace current]]::http::search] + + variable type $xChar + variable selector "$xChar*" + variable string $selector + variable schemepart \ + "//${hostOrPort}(/(${type}(${selector}(%09${search}(%09${string})?)?)?)?)?" + variable url "gopher:${schemepart}" +} + +# MAILTO +uri::register mailto { + variable xChar [set [namespace parent [namespace current]]::basic::xChar] + variable host [set [namespace parent [namespace current]]::basic::host] + + variable schemepart "$xChar+(@${host})?" + variable url "mailto:${schemepart}" +} + +# NEWS +uri::register news { + variable escape [set [namespace parent [namespace current]]::basic::escape] + variable alpha [set [namespace parent [namespace current]]::basic::alpha] + variable host [set [namespace parent [namespace current]]::basic::host] + + variable aCharN {[a-zA-Z0-9$_.+!*'(,);/?:&=-]} + variable aChar "($aCharN|${escape})" + variable gChar {[a-zA-Z0-9$_.+-]} + variable newsgroup-name "${alpha}${gChar}*" + variable message-id "${aChar}+@${host}" + variable schemepart "\\*|${newsgroup-name}|${message-id}" + variable url "news:${schemepart}" +} + +# WAIS +uri::register wais { + variable uChar \ + [set [namespace parent [namespace current]]::basic::xChar] + variable hostOrPort \ + [set [namespace parent [namespace current]]::basic::hostOrPort] + variable search \ + [set [namespace parent [namespace current]]::http::search] + + variable db "${uChar}*" + variable type "${uChar}*" + variable path "${uChar}*" + + variable database "//${hostOrPort}/${db}" + variable index "//${hostOrPort}/${db}\\?${search}" + variable doc "//${hostOrPort}/${db}/${type}/${path}" + + #variable schemepart "${doc}|${index}|${database}" + + variable schemepart \ + "//${hostOrPort}/${db}((\\?${search})|(/${type}/${path}))?" + + variable url "wais:${schemepart}" +} + +# PROSPERO +uri::register prospero { + variable escape \ + [set [namespace parent [namespace current]]::basic::escape] + variable hostOrPort \ + [set [namespace parent [namespace current]]::basic::hostOrPort] + variable path \ + [set [namespace parent [namespace current]]::ftp::path] + + variable charN {[a-zA-Z0-9$_.+!*'(,)?:@&-]} + variable char "(${charN}|$escape)" + + variable fieldname "${char}*" + variable fieldvalue "${char}*" + variable fieldspec ";${fieldname}=${fieldvalue}" + + variable schemepart "//${hostOrPort}/${path}(${fieldspec})*" + variable url "prospero:$schemepart" +} + +package provide uri 1.1.4 diff -Naur wikit.vfs.orig/lib/uri/urn-scheme.tcl wikit.vfs/lib/uri/urn-scheme.tcl --- wikit.vfs.orig/lib/uri/urn-scheme.tcl Thu Jan 1 03:00:00 1970 +++ wikit.vfs/lib/uri/urn-scheme.tcl Wed Oct 6 05:35:22 2004 @@ -0,0 +1,136 @@ +# urn-scheme.tcl - Copyright (C) 2001 Pat Thoyts +# +# extend the uri package to deal with URN (RFC 2141) +# see http://www.normos.org/ietf/rfc/rfc2141.txt +# +# Released under the tcllib license. +# +# $Id: urn-scheme.tcl,v 1.8 2004/08/03 09:25:10 patthoyts Exp $ +# ------------------------------------------------------------------------- + +package require uri 1.1.2 + +namespace eval ::uri {} +namespace eval ::uri::urn { + variable version 1.0.2 +} + +# ------------------------------------------------------------------------- + +# Description: +# Called by uri::split with a url to split into its parts. +# +proc ::uri::SplitUrn {uri} { + #@c Split the given uri into then URN component parts + #@a uri: the URI to split without it's scheme part. + #@r List of the component parts suitable for 'array set' + + upvar \#0 [namespace current]::urn::URNpart pattern + array set parts {nid {} nss {}} + if {[regexp -- ^$pattern $uri -> parts(nid) parts(nss)]} { + return [array get parts] + } else { + error "invalid urn syntax: \"$uri\" could not be parsed" + } +} + + +# ------------------------------------------------------------------------- + +proc ::uri::JoinUrn args { + #@c Join the parts of a URN scheme URI + #@a list of nid value nss value + #@r a valid string representation for your URI + variable urn::NIDpart + + array set parts [list nid {} nss {}] + array set parts $args + if {! [regexp -- ^$NIDpart$ $parts(nid)]} { + error "invalid urn: nid is invalid" + } + set url "urn:$parts(nid):[urn::quote $parts(nss)]" + return $url +} + +# ------------------------------------------------------------------------- + +# Quote the disallowed characters according to the RFC for URN scheme. +# ref: RFC2141 sec2.2 +proc ::uri::urn::quote {url} { + variable trans + + set ndx 0 + set result "" + while {[regexp -indices -- "\[^$trans\]" $url r]} { + set ndx [lindex $r 0] + scan [string index $url $ndx] %c chr + set rep %[format %.2X $chr] + if {[string match $rep %00]} { + error "invalid character: character $chr is not allowed" + } + + incr ndx -1 + append result [string range $url 0 $ndx] $rep + incr ndx 2 + set url [string range $url $ndx end] + } + append result $url + return $result +} + +# ------------------------------------------------------------------------- +# Perform the reverse of urn::quote. + +if { [package vcompare [package provide Tcl] 8.3] < 0 } { + # Before Tcl 8.3 we do not have 'regexp -start'. We simulate it by + # using 'string range' and adjusting the match results. + + proc ::uri::urn::unquote {url} { + set result "" + set start 0 + while {[regexp -indices {%[0-9a-fA-F]{2}} [string range $url $start end] match]} { + foreach {first last} $match break + incr first $start ; # Make the indices relative to the true string. + incr last $start ; # I.e. undo the effect of the 'string range' on match results. + append result [string range $url $start [expr {$first - 1}]] + append result [format %c 0x[string range $url [incr first] $last]] + set start [incr last] + } + append result [string range $url $start end] + return $result + } +} else { + proc ::uri::urn::unquote {url} { + set result "" + set start 0 + while {[regexp -start $start -indices {%[0-9a-fA-F]{2}} $url match]} { + foreach {first last} $match break + append result [string range $url $start [expr {$first - 1}]] + append result [format %c 0x[string range $url [incr first] $last]] + set start [incr last] + } + append result [string range $url $start end] + return $result + } +} + +# ------------------------------------------------------------------------- + +::uri::register {urn URN} { + variable NIDpart {[a-zA-Z0-9][a-zA-Z0-9-]{0,31}} + variable esc {%[0-9a-fA-F]{2}} + variable trans {a-zA-Z0-9$_.+!*'(,):=@;-} + variable NSSpart "($esc|\[$trans\])+" + variable URNpart "($NIDpart):($NSSpart)" + variable schemepart $URNpart + variable url "urn:$NIDpart:$NSSpart" +} + +# ------------------------------------------------------------------------- + +package provide uri::urn $::uri::urn::version + +# ------------------------------------------------------------------------- +# Local Variables: +# indent-tabs-mode: nil +# End: diff -Naur wikit.vfs.orig/lib/wikit/db.tcl wikit.vfs/lib/wikit/db.tcl --- wikit.vfs.orig/lib/wikit/db.tcl Mon Jun 7 09:58:33 2004 +++ wikit.vfs/lib/wikit/db.tcl Wed Dec 1 10:15:41 2004 @@ -284,6 +284,8 @@ proc DoSync {url {db wdb}} { puts "Looking for changes at $url ..." package require http + package require autoproxy + autoproxy::init set re \ "^Title:\\s+(\[^\n]+)\nDate:\\s+(\[^\n]+)\nSite:\\s+(\[^\n]+)\n\n(.*)" set index [graburl $url/index] @@ -301,7 +303,7 @@ if {[regexp $re $page - t d s p]} { puts " $t - $d" SavePageDB $db $xpage $p $s $t $xdate - if {[incr i] % 10 == 0} DoCommit $db + if {[incr i] % 10 == 0} {DoCommit $db} } else { puts ? } diff -Naur wikit.vfs.orig/lib/wikit/image.tcl wikit.vfs/lib/wikit/image.tcl --- wikit.vfs.orig/lib/wikit/image.tcl Wed Sep 8 06:27:33 2004 +++ wikit.vfs/lib/wikit/image.tcl Wed Dec 1 09:47:44 2004 @@ -69,6 +69,8 @@ set todo [mk::select wdb.images date 0] puts "Fetching [llength $todo] images..." package require http + package require autoproxy + autoproxy::init set count 0 foreach x $todo { array set f [mk::get wdb.images!$x]