initial checkin of TclCurl

tests/basic.tcl

@@ -0,0 +1,8 @@
+package require TclCurl
+
+curl::transfer -url "127.0.0.1"
+
+
+
+
+

tests/bodyVar.tcl

@@ -0,0 +1,36 @@
+package require TclCurl
+
+# These tests has some urls that don't exists outside my system,
+# so IT WON'T WORK FOR YOU unless you change them.
+
+set curlHandle [curl::init]
+$curlHandle configure -url "127.0.0.1" -bodyvar body -noprogress 1 
+$curlHandle perform
+
+$curlHandle configure -url "127.0.0.1/~andres/" -bodyvar newBody
+$curlHandle perform
+
+$curlHandle cleanup
+
+puts "First page:"
+puts $body
+
+puts "Second page:"
+puts $newBody
+
+# You can also use it for binary transfers
+
+curl::transfer \
+        -url {127.0.0.1/~andres/HomePage/getleft/images/getleft.png} \
+        -bodyvar image -noprogress 1 -verbose 1
+
+if [catch {open "getleft.png" w} out] {
+    puts "Could not open $out."
+    exit
+}
+
+fconfigure $out -translation binary
+puts  $out $image
+close $out
+
+

tests/bufferSize.tcl

@@ -0,0 +1,24 @@
+package require TclCurl
+
+# This is one contrived example, but it works.
+
+proc writeToFile {readData} {
+    puts "writeToFile called [incr ::i]"
+    puts -nonewline $::inFile $readData
+
+    return
+}
+
+set i 0
+
+set inFile [open "cosa.tar" w+]
+fconfigure $inFile -translation binary
+
+curl::transfer -url "127.0.0.1/~andres/cosa&co.tar" \
+        -writeproc writeToFile -buffersize 250
+
+close $inFile
+
+
+
+

tests/command.tcl

@@ -0,0 +1,10 @@
+package require TclCurl
+
+curl::transfer -url "127.0.0.1" -command "puts \"\nTransfer complete\n\""
+
+
+
+
+
+
+

tests/cookie.tcl

@@ -0,0 +1,8 @@
+package require TclCurl
+
+curl::transfer -url "127.0.0.1" -cookie "name=andres;" -verbose 1
+
+
+
+
+

tests/cookieFile.tcl

@@ -0,0 +1,13 @@
+package require TclCurl
+
+if {![file exists /home/andres/.getleft/cookies]} {
+    puts "The given cookie file doesn't exist"
+}
+
+curl::transfer -url 127.0.0.1 \
+        -cookiefile "/home/andres/.getleft/cookies" -verbose 1
+
+
+
+
+

tests/curlConfig.tcl

@@ -0,0 +1,12 @@
+package require TclCurl
+
+puts "cURL is installed in: [curl::curlConfig -prefix]"
+
+set compiledOptions [curl::curlConfig -feature]
+regsub -all {\n} $compiledOptions { - } compiledOptions
+puts "The compiled options: $compiledOptions"
+
+puts "The version in hex: [curl::curlConfig -vernum]"
+
+puts "The built-in path to the CA cert bundle:\n\t[curl::curlConfig -ca]"
+

tests/debugProc.tcl

@@ -0,0 +1,41 @@
+package require TclCurl
+
+proc DebugProc {infoType data} {
+
+    switch $infoType {
+        0 {
+            set type "text"
+        }
+        1 {
+            set type "incoming header"
+        }
+        2 {
+            set type "outgoing header"
+        }
+        3 {
+            set type "incoming data"
+        }
+        4 {
+            set type "outgoing data"
+        }
+        5 {
+            set type "incoming SSL data"
+        }
+        6 {
+            set type "outgoing SSL data"
+        }
+    }
+
+    puts "Type: $type - Data:"
+    puts "$data"
+
+    return 0
+}
+
+set curlHandle [curl::init]
+
+$curlHandle configure -url 127.0.0.1 -verbose 1 \
+        -debugproc DebugProc
+
+$curlHandle perform
+$curlHandle cleanup

tests/dict.tcl

@@ -0,0 +1,7 @@
+package require TclCurl
+
+curl::transfer -url "dict://dict.org/m:curl"
+
+
+
+

tests/dupHandle.tcl

@@ -0,0 +1,16 @@
+package require TclCurl
+
+set curlHandle1 [curl::init]
+
+$curlHandle1 configure -url 127.0.0.1
+
+set curlHandle2 [$curlHandle1 duphandle]
+
+$curlHandle1 configure -url 127.0.0.1/~andres/
+
+$curlHandle2 perform
+
+
+$curlHandle1 cleanup
+$curlHandle2 cleanup
+

tests/encoding.tcl

@@ -0,0 +1,9 @@
+package require TclCurl
+
+curl::transfer -url "http://127.0.0.1" -encoding deflated -verbose 1
+
+curl::transfer -url "http://127.0.0.1" -encoding all      -verbose 1
+
+
+
+

tests/errorBuffer.tcl

@@ -0,0 +1,23 @@
+package require TclCurl
+
+set curlHandle [curl::init]
+$curlHandle configure -url "Shire.Asturias.com" -errorbuffer errorMsg
+
+if {[catch {$curlHandle perform}]} {
+	puts "The error message: $errorMsg"
+}
+
+$curlHandle configure -url "Shire.Asturias.com" -errorbuffer error(msg)
+
+if {[catch {$curlHandle perform}]} {
+	puts "The error message: $error(msg)"
+}
+
+$curlHandle cleanup
+
+unset error
+catch {curl::transfer -url "Shire.Asturias.com" -errorbuffer error(msg)}
+
+puts "Error: $error(msg)"
+
+

tests/escape.tcl

@@ -0,0 +1,6 @@
+package require TclCurl
+
+
+set escaped [curl::escape {What about this?}]
+puts "String to escape: What about this? - $escaped"
+puts "And the reverse: [curl::unescape $escaped]"

tests/failOnError.tcl

@@ -0,0 +1,17 @@
+package require TclCurl
+
+set curlHandle [curl::init]
+$curlHandle configure -url "127.0.0.1/cosa.html"
+
+$curlHandle configure -failonerror 0 ; # This is the default
+puts "With failonerror==0:"
+catch {$curlHandle perform}
+puts "\n\n\n\n\n"
+puts "With failonerror==1:"
+$curlHandle configure -failonerror 1
+catch {$curlHandle perform}
+
+$curlHandle cleanup
+
+
+

tests/file.tcl

@@ -0,0 +1,17 @@
+package require TclCurl
+
+set curlHandle [curl::init]
+$curlHandle configure -url "127.0.0.1" -file "index.html"
+$curlHandle perform
+
+puts "First transfer finished\n"
+
+$curlHandle configure -header  1 -file cosa.html
+$curlHandle perform
+
+$curlHandle cleanup
+
+
+
+
+

tests/fileNoFile.tcl

@@ -0,0 +1,20 @@
+package require TclCurl
+
+set curlHandle [curl::init]
+
+puts "First we save in 'index.html'"
+
+$curlHandle configure -noprogress  1 -url "127.0.0.1" -file "index.html"
+$curlHandle perform
+
+puts "And now in stdout"
+
+$curlHandle configure -file ""
+$curlHandle perform
+
+$curlHandle cleanup
+
+
+
+
+

tests/formGet.tcl

@@ -0,0 +1,13 @@
+package require TclCurl
+
+curl::transfer -url "http://www.google.com/search?q=TclCurl&hl=en&btnG=Google+Search+&lr=" \
+        -file tclcurl.html -cookiejar [file join [file dirname [info script]] cookieJar.txt]
+puts "Transfer saved in 'tclcurl.html'"
+puts "Cookies en el fichero: [file join [file dirname [info script]] cookieJar.txt]"
+
+
+
+
+
+
+

tests/ftp.tcl

@@ -0,0 +1,22 @@
+package require TclCurl
+
+puts "nobody==1 --- header==1"
+curl::transfer -url "ftp://127.0.0.1/pub/indust2.gif" -nobody 1 -header 1
+
+puts "nobody==0 --- header ignored"
+curl::transfer -url "ftp://127.0.0.1/pub/indust2.gif" -nobody 0 \
+        -file cosa.gif
+
+puts "nobody==1 --- HEADERS==0"
+curl::transfer -url "ftp://127.0.0.1/pub/indust2.gif" -nobody 1 \
+        -header 0 -postquote [list "mkdir nada"]
+
+
+
+
+
+
+
+
+
+

tests/ftpList.tcl

@@ -0,0 +1,9 @@
+package require TclCurl
+
+curl::transfer -url "ftp://127.0.0.1/pub/" -ftplistonly 1
+
+
+
+
+
+

tests/ftpUpload.tcl

@@ -0,0 +1,25 @@
+package require TclCurl
+
+set buffer ""
+if {[catch {curl::transfer -url ftp://127.0.0.1/Test/cosa.tcl \
+        -userpwd "user:pwd" -verbose 1                        \
+        -infile ftpUpload.tcl -upload 1  -errorbuffer buffer  \
+        -quote [list "mkd Test"]                              \
+        -postquote [list "rnfr cosa.tcl" "rnto script.tcl"]   \
+      } buffer]} {
+    puts "Error: $buffer"
+} else {
+    puts "Upload complete"
+}
+
+
+
+
+
+
+
+
+
+
+
+

tests/ftpWildcard.tcl

@@ -0,0 +1,81 @@
+package require TclCurl
+
+proc FtpMatch {pattern filename} {
+
+    puts "Pattern: $pattern - File: $filename"
+
+    # For this example everything matches
+    return 0
+}
+
+proc FtpCheck {remains} {
+    global someVar
+
+    # Lets forget about directories:
+    if {($someVar(filetype) eq "directory") || ([regexp {^\.} $someVar(filename)])} {
+        return 1
+    }
+
+    puts -nonewline "File to download $someVar(filename) ($someVar(size)B) (y/N): "
+    flush stdout
+    set line [string tolower [gets stdin]]
+    if {$line eq y} {
+        return 0
+    }
+    return  1
+}
+
+proc FtpSaveFile {readData} {
+    global   outFile
+    global   openedFile
+    global   someVar
+
+    if {$openedFile==0} {
+        if {![file exists downloads]} {
+            file mkdir downloads
+        }
+        set outFile [open "downloads/$someVar(filename)" w+]
+        fconfigure $outFile -translation binary
+    }
+
+    puts -nonewline $outFile $readData
+
+    return 0
+}
+
+proc FtpDone {} {
+    global outFile
+    global openedFile
+
+    puts "Done\n"
+
+    close $outFile
+    set openedFile 0
+
+    return 0
+}
+
+set openedFile 0
+set curlHandle [curl::init]
+
+$curlHandle configure -url ftp://sunsite.rediris.es/sites/metalab.unc.edu/ldp/*
+$curlHandle configure -chunkbgnproc  FtpCheck
+$curlHandle configure -chunkbgnvar   someVar
+$curlHandle configure -chunkendproc  FtpDone
+$curlHandle configure -writeproc     FtpSaveFile
+$curlHandle configure -wildcardmatch 1
+$curlHandle configure -fnmatchproc   FtpMatch
+
+$curlHandle perform
+
+$curlHandle cleanup
+
+
+
+
+
+
+
+
+
+

tests/getInfo.tcl

@@ -0,0 +1,55 @@
+package require TclCurl
+
+set curlHandle [curl::init]
+$curlHandle configure -url "127.0.0.1" -filetime 1  -verbose 1             \
+         -cookielist "127.0.0.1\tFALSE\t/\tFALSE\t1262307600\tad_browser_id\t  18864635"
+$curlHandle perform
+
+puts "Url: [$curlHandle getinfo effectiveurl]"
+puts "Primary IP: [$curlHandle getinfo primaryip]"
+puts "Primary port: [$curlHandle getinfo primaryport]"
+puts "Local IP: [$curlHandle getinfo localip]"
+puts "Local port: [$curlHandle getinfo localport]"
+puts "Redirect url: [$curlHandle getinfo redirecturl]"
+puts "Http-code: [$curlHandle getinfo responsecode]"
+puts "Proxy response code: [$curlHandle getinfo httpconnectcode]"
+set fileTime [$curlHandle getinfo filetime]
+puts "Filetime: $fileTime - [clock format $fileTime]"
+puts "Total time: [$curlHandle getinfo totaltime]"
+puts "Name lookup time: [$curlHandle getinfo namelookuptime]"
+puts "Name connect time: [$curlHandle getinfo connecttime]"
+puts "Name pretransfer time: [$curlHandle getinfo pretransfertime]"
+puts "Name start transfer time: [$curlHandle getinfo starttransfertime]"
+puts "Name app connect time: [$curlHandle getinfo appconnecttime]"
+puts "Name size upload: [$curlHandle getinfo sizeupload]"
+puts "Name size download: [$curlHandle getinfo sizedownload]"
+puts "Name speed download: [$curlHandle getinfo speeddownload]"
+puts "Name speed upload: [$curlHandle getinfo speedupload]"
+puts "Name header size: [$curlHandle getinfo headersize]"
+puts "Name request size: [$curlHandle getinfo requestsize]"
+puts "Name ssl verifyresult: [$curlHandle getinfo sslverifyresult]"
+puts "SSL engines: [$curlHandle getinfo sslengines]"
+puts "Name length download: [$curlHandle getinfo contentlengthdownload]"
+puts "Name length upload: [$curlHandle getinfo contentlengthupload]"
+puts "Content-Type: [$curlHandle getinfo contenttype]"
+puts "Redirect time: [$curlHandle getinfo redirecttime]"
+puts "Redirect count: [$curlHandle getinfo redirectcount]"
+puts "Authentication methods available: [$curlHandle getinfo httpauthavail]"
+puts "Authentication methods at the proxy: [$curlHandle getinfo proxyauthavail]"
+puts "Operating System error number: [$curlHandle getinfo oserrno]"
+puts "Number of successful connects: [$curlHandle getinfo numconnects]"
+puts "Known cookies: [$curlHandle getinfo cookielist]"
+set certList [$curlHandle getinfo certinfo]
+set certNum  [lindex $certList 0]
+puts "N<EFBFBD> de certificados: $certNum"
+for {set i 1} {$i<=$certNum} {incr i} {
+    puts [lindex $certList $i]
+}
+
+$curlHandle cleanup
+
+
+
+
+
+

tests/headNoHead.tcl

@@ -0,0 +1,21 @@
+package require TclCurl
+
+set curlHandle [curl::init]
+
+puts "First we save the headers in 'header.txt'"
+
+$curlHandle configure -noprogress 1 -nobody 1 -url "127.0.0.1" \
+        -writeheader header.txt
+$curlHandle perform
+
+puts "And now we dump them to the console"
+
+$curlHandle configure -writeheader ""
+$curlHandle perform
+
+$curlHandle cleanup
+
+
+
+
+

tests/header.tcl

@@ -0,0 +1,8 @@
+package require TclCurl
+
+curl::transfer -url "127.0.0.1" -header 1 -nobody 1
+
+
+
+
+

tests/headerVar.tcl

@@ -0,0 +1,13 @@
+package require TclCurl
+
+curl::transfer -url 127.0.0.1 -header 1 -nobody 1 -headervar headers
+
+puts "The received headers"
+foreach {key content} [array get headers] {
+    puts "headers($key): $content"
+}
+
+
+
+
+

tests/http200Aliases.tcl

@@ -0,0 +1,12 @@
+package require TclCurl
+
+curl::transfer -url "127.0.0.1" -verbose 1 -nobody 1 -header 1     \
+        -http200aliases [list "yummy/4.5 200 OK" "great/1.3 350 WRONG"]
+
+        
+
+
+
+
+
+

tests/httpBufferPost.tcl

@@ -0,0 +1,14 @@
+package require TclCurl
+
+
+set fileContent "This is what we will send as if it was the content of a file"
+
+curl::transfer -url 127.0.0.1/cgi-bin/post1.tcl -verbose 1 -post 1                                                         \
+        -httppost [list name "firstName" contents "Andres" contenttype "text/plain" contentheader [list "adios: goodbye"]] \
+        -httppost [list name "lastName"  contents "Garcia"]                                                                \
+        -httppost [list name "nombre"    bufferName noFile.txt      buffer $fileContent contenttype "text/html"]           \
+        -httppost [list name "submit"    contents "send"] -verbose 1
+
+
+
+

tests/httpHeader.tcl

@@ -0,0 +1,12 @@
+package require TclCurl
+
+curl::transfer -url "127.0.0.1" -verbose 1 -nobody 1 \
+        -httpheader [list "hola: hello" "adios: goodbye"]
+
+
+
+
+
+
+
+

tests/httpPost.tcl

@@ -0,0 +1,14 @@
+package require TclCurl
+
+
+curl::transfer -url 127.0.0.1/cgi-bin/post1.tcl -verbose 1 -post 1                   \
+        -httppost [list name "firstName" contents "Andres" contenttype "text/plain" contentheader [list "adios: goodbye"]]                                       \
+        -httppost [list name "lastName"  contents "Garcia"]                          \
+        -httppost [list name "file"      file     "httpPost.tcl" file "basico.tcl" contenttype text/plain filename "c:\\basico.tcl"]                            \
+        -httppost [list name "AnotherFile" filecontent "httpBufferPost.tcl"]         \
+        -httppost [list name "submit"    contents "send"] -verbose 1
+
+
+
+
+

tests/httpVersion.tcl

@@ -0,0 +1,13 @@
+package require TclCurl
+
+curl::transfer -url "127.0.0.1" -httpversion none -verbose 1 -nobody 1
+
+curl::transfer -url "127.0.0.1" -httpversion 1.0  -verbose 1 -nobody 1
+
+curl::transfer -url "127.0.0.1" -httpversion 1.1  -verbose 1 -nobody 1
+
+
+
+
+
+

tests/https.tcl

@@ -0,0 +1,13 @@
+package require TclCurl
+
+if {$tcl_platform(platform)=="windows"} {
+    set certFile [file join $env(windir) curl-ca-bundle.crt]
+} else {
+    set certFile /usr/local/share/curl/curl-ca-bundle.crt
+}
+
+::curl::transfer -url https://www.paypal.com/ -cainfo $certFile \
+        -file paypal.html
+
+
+puts "https://www.paypal.com/ saved in 'paypal.html'"

tests/interface.tcl

@@ -0,0 +1,11 @@
+package require TclCurl
+
+curl::transfer -url 127.0.0.1 -verbose 1 -interface 127.0.0.1 -nobody 1
+
+
+
+
+
+
+
+

tests/ipresolve.tcl

@@ -0,0 +1,14 @@
+package require TclCurl
+
+set curlHandle [curl::init]
+$curlHandle configure -url "http://127.0.0.1" -filetime 1 -ipresolve v4 \
+        -verbose 1 -nobody 1
+$curlHandle perform
+
+$curlHandle cleanup
+
+
+
+
+
+

tests/multi/auto.tcl

@@ -0,0 +1,31 @@
+#!/usr/local/bin/wish8.4
+
+package require TclCurl
+
+#wm withdraw .
+
+proc CleanUp {multiHandle easyHandle} {
+    puts "\n\nCleaning up\n\n"
+
+    $::multiHandle removehandle $::easyHandle
+    $::multiHandle cleanup
+    $::easyHandle  cleanup
+
+    puts "\n\nAll done\n\n"
+
+    exit
+}
+
+set multiHandle [curl::multiinit]
+set easyHandle  [curl::init]
+
+$easyHandle  configure -url http://127.0.0.1/~andres/HomePage.tar.gz -file home.tar.gz
+
+$multiHandle addhandle $easyHandle
+
+puts "Starting transfer..."
+
+$multiHandle auto -command "CleanUp $multiHandle $easyHandle"
+
+
+

tests/multi/autoGUI.tcl

@@ -0,0 +1,31 @@
+#!/usr/local/bin/wish8.4
+
+package require TclCurl
+
+proc CleanUp {multiHandle easyHandle} {
+    puts "\n\nCleaning up $multiHandle - $easyHandle\n\n"
+
+    $multiHandle removehandle $easyHandle
+    $multiHandle cleanup
+    $easyHandle  cleanup
+
+    puts "\n\nAll done\n\n"
+
+    exit
+}
+
+proc StartTransfer {} {
+    set multiHandle [curl::multiinit]
+    set easyHandle  [curl::init]
+
+    $easyHandle  configure -url http://127.0.0.1/~andres/HomePage.tar.gz -file home.tar.gz
+
+    $multiHandle addhandle $easyHandle
+
+    $multiHandle auto -command "CleanUp $multiHandle $easyHandle"
+}
+
+set start [button .start -text Start -command StartTransfer]
+set stop  [button .stop  -text Stop  -command StopTransfer]
+
+pack $start $stop -side left -padx 10 -pady 10

tests/multi/cancelTrans.tcl

@@ -0,0 +1,80 @@
+#!/usr/local/bin/wish8.4
+
+package require TclCurl
+
+proc ProgressCallback {dltotal dlnow ultotal ulnow} {
+
+    set dltotal [expr round($dltotal)]
+    set dlnow   [expr round($dlnow)]
+    set ultotal [expr round($ultotal)]
+    set ulnow   [expr round($ulnow)]
+
+    puts "Progress callback: $dltotal - $dlnow - $ultotal - $ulnow"
+
+    return
+}
+
+proc Perform {multiHandle} {
+    if {[catch {$multiHandle active} activeTransfers]} {
+        puts "Error checking active transfers: $activeTransfers"
+        return -1
+    }
+
+    if {[catch {$multiHandle perform} running]} {
+        puts "Error: $running"
+        return -1
+    }
+    return $running
+}
+
+proc Transfer {multiHandle easyHandle} {
+    global eventId
+    set runningTransfers [Perform $multiHandle]
+    if {$runningTransfers>0} {
+        set eventId [after 200 "Transfer $multiHandle $easyHandle"]
+    } else {
+        puts "Were are done, cleaning up..."
+        $multiHandle removehandle $easyHandle
+        $easyHandle  cleanup
+        $multiHandle cleanup
+        puts "All done"
+    }
+    return
+}
+
+proc StartTransfer {} {
+
+    set curlEasyHandle [curl::init]
+
+    $curlEasyHandle configure -url "127.0.0.1/~andres/cosa&co.tar"          \
+            -canceltransvarname cancel   -progressproc ProgressCallback\
+            -file cosa.tar -noprogress 0
+
+    set curlMultiHandle [curl::multiinit]
+    $curlMultiHandle addhandle $curlEasyHandle
+
+    after 100 "Transfer $curlMultiHandle $curlEasyHandle"
+
+    return
+}
+
+proc StopTransfer {} {
+    global cancel eventId
+
+    puts "The download has been cancelled"
+
+    set cancel 1
+
+    return
+}
+
+set start [button .start -text Start -command StartTransfer]
+set stop  [button .stop  -text Stop  -command StopTransfer]
+
+pack $start $stop -side left -padx 10 -pady 10
+
+
+
+
+
+

tests/multi/double.tcl

@@ -0,0 +1,57 @@
+package require TclCurl
+
+
+proc Perform {multiHandle} {
+    if {[catch {$multiHandle active} activeTransfers]} {
+        puts "Error checking active transfers: $activeTransfers"
+        return -1
+    }
+    if {[catch {$multiHandle perform} running]} {
+        puts "Error: $running"
+        return 1
+    }
+    return $running
+}
+
+proc StartTransfer {multiHandle} {
+    while {1==1} {
+        set runningTransfers [Perform $multiHandle]
+        if {$runningTransfers>0} {
+            after 500
+        } else {
+            break
+        }
+    }
+}
+
+puts "We create and configure the easy handles"
+
+set curlEasyHandle1 [curl::init]
+set curlEasyHandle2 [curl::init]
+
+$curlEasyHandle1 configure -url http://127.0.0.1/~andres/ -file index.html
+$curlEasyHandle2 configure -url http://127.0.0.1/ -file index2.html
+
+puts "Creating the multi handle"
+
+set curlMultiHandle [curl::multiinit]
+
+puts "Adding easy handles to the multi one"
+
+$curlMultiHandle addhandle $curlEasyHandle1
+$curlMultiHandle addhandle $curlEasyHandle2
+
+puts "We start the transfer"
+
+StartTransfer $curlMultiHandle
+
+puts "Transfer done, cleanning up"
+
+$curlMultiHandle removehandle $curlEasyHandle1
+$curlMultiHandle removehandle $curlEasyHandle2
+
+$curlMultiHandle cleanup
+$curlEasyHandle1 cleanup
+$curlEasyHandle2 cleanup
+
+

tests/multi/single.tcl

@@ -0,0 +1,52 @@
+package require TclCurl
+
+proc Perform {multiHandle} {
+    if {[catch {$multiHandle active} activeTransfers]} {
+        puts "Error checking active transfers: $activeTransfers"
+        return -1
+    }
+
+    if {[catch {$multiHandle perform} running]} {
+        puts "Error: $running"
+        return 1
+    }
+    return $running
+}
+
+proc StartTransfer {multiHandle} {
+    while {1==1} {
+        set runningTransfers [Perform $multiHandle]
+        if {$runningTransfers>0} {
+            after 500
+        } else {
+            break
+        }
+    }
+}
+
+set curlEasyHandle [curl::init]
+
+$curlEasyHandle configure -url http://127.0.0.1/ -file index.html
+
+if {[catch {curl::multiinit} curlMultiHandle]} {
+    puts "Error with multi handle init"
+}
+
+puts "The multi handle: $curlMultiHandle"
+
+puts -nonewline "We add the easy handle: "
+puts [$curlMultiHandle addhandle $curlEasyHandle]
+
+StartTransfer $curlMultiHandle
+
+puts "Calling getinfo [$curlMultiHandle getinfo]"
+
+puts -nonewline "Removing the easy handle: "
+puts [$curlMultiHandle removehandle $curlEasyHandle]
+
+puts -nonewline "Cleanup the multi handle handle: "
+puts [$curlMultiHandle cleanup]
+
+$curlEasyHandle cleanup
+
+

tests/netrcfile.tcl

@@ -0,0 +1,10 @@
+package require TclCurl
+
+curl::transfer -url "ftp://Strider.Asturias.es" -verbose 1           \
+        -netrc required -netrcfile "/home/andres/testnetrc"
+
+
+
+
+
+

tests/noProgress.tcl

@@ -0,0 +1,12 @@
+package require TclCurl
+
+# The default is not to show the progress meter.
+
+curl::transfer -url 127.0.0.1 -noprogress 1
+
+
+
+
+
+
+

tests/nobody.tcl

@@ -0,0 +1,8 @@
+package require TclCurl
+
+curl::transfer -url 127.0.0.1 -header 1 -nobody 1
+
+
+
+
+

tests/ntlm.tcl

@@ -0,0 +1,16 @@
+# Contributed by Jos Decoster
+
+set curlHandle [curl::init]
+
+$curlHandle configure                                        \
+        -verbose 1 -failonerror 1 -errorbuffer ::errorBuffer \
+        -url $::url -file $::file                            \
+        -proxy $::proxy_host -proxyport $::proxy_port        \
+        -proxyauth ntlm                                      \
+        -proxyuserpwd $::proxy_user:$::proxy_password
+
+if { [catch {$curlHandle perform} r] } {
+    return -code error "$r $::errorBuffer"
+}
+
+$curlHandle cleanup

tests/pop3.tcl

@@ -0,0 +1,26 @@
+package require TclCurl
+
+set curlHandle [curl::init]
+
+# This just checks the server for messages, if you want to download them
+# you need: -url "pop3://pop3.telefonica.net:110/1",  -url "pop3://pop3.telefonica.net:110/2", etc
+
+$curlHandle configure -url "pop3://pop3.telefonica.net:110"
+
+$curlHandle configure -username "fandom\$telefonica.net"
+$curlHandle configure -password "XXXXXXXX"
+
+$curlHandle configure -bodyvar recieved
+
+$curlHandle configure -verbose 1
+
+$curlHandle perform
+
+$curlHandle cleanup
+
+puts "Recieved:"
+puts \n$recieved\n\n
+
+
+
+

tests/progressProc.tcl

@@ -0,0 +1,27 @@
+package require TclCurl
+
+proc ProgressCallback {dltotal dlnow ultotal ulnow} {
+
+    set dltotal [expr int($dltotal)]
+    set dlnow   [expr int($dlnow)]
+    set ultotal [expr int($ultotal)]
+    set ulnow   [expr int($ulnow)]
+
+    puts "Progress callback: $dltotal - $dlnow - $ultotal - $ulnow"
+
+    return
+}
+
+
+set curlHandle [curl::init]
+
+$curlHandle configure -url "127.0.0.1/~andres/cosa&co.tar"  \
+        -progressproc ProgressCallback -file cosa.tar -noprogress 0
+$curlHandle perform
+
+$curlHandle cleanup
+
+
+
+
+

tests/progressProcPause.tcl

@@ -0,0 +1,39 @@
+package require TclCurl
+
+# Another one of my contrived but working examples.
+
+proc ProgressCallback {dltotal dlnow ultotal ulnow} {
+    global i curlHandle
+    
+    set dltotal [expr int($dltotal)]
+    set dlnow   [expr int($dlnow)]
+    set ultotal [expr int($ultotal)]
+    set ulnow   [expr int($ulnow)]
+
+    puts "$i Progress callback: $dlnow of $dltotal downloaded"
+
+    if {$i==10} {
+        $curlHandle pause
+    } elseif {$i==30} {
+        $curlHandle resume
+    }
+    incr i
+
+    return
+}
+
+
+set i 0
+
+set curlHandle [curl::init]
+
+$curlHandle configure -url "127.0.0.1/~andres/cosa&co.tar"  \
+        -progressproc ProgressCallback -file cosa.tar -noprogress 0
+$curlHandle perform
+
+$curlHandle cleanup
+
+
+
+
+

tests/proxy.tcl

@@ -0,0 +1,11 @@
+package require TclCurl
+
+curl::transfer -url http://curl.haxx.se -verbose 1  -proxy "192.168.0.0"
+
+
+
+
+
+
+
+

tests/proxyPort.tcl

@@ -0,0 +1,12 @@
+package require TclCurl
+
+curl::transfer -url http://curl.haxx.com -verbose 1 	\
+        -proxy 192.168.0.0 -proxyport 8080
+
+
+
+
+
+
+
+

tests/proxyTunnel.tcl

@@ -0,0 +1,11 @@
+package require TclCurl
+
+curl::transfer -url http://curl.haxx.se -verbose 1 \
+        -proxy "192.168.0.0:8080" -httpproxytunnel 1
+
+
+
+
+
+
+

tests/range.tcl

@@ -0,0 +1,8 @@
+package require TclCurl
+
+curl::transfer -url 127.0.0.1 -range "100-500"
+
+
+
+
+

tests/readProc.tcl

@@ -0,0 +1,23 @@
+package require TclCurl
+
+# As an example this is very contrived, but it works.
+
+proc readFile {size} {
+
+    set chunk [read $::inFile $size]
+
+    return $chunk
+}
+
+set inFile [open "cosa.tar" r]
+fconfigure $inFile -translation binary
+
+curl::transfer -url "ftp://127.0.0.1/cosa.tar" -verbose 1 \
+	-username user -password pass -readproc readFile -upload 1
+
+close $inFile
+
+
+
+
+

tests/referer.tcl

@@ -0,0 +1,9 @@
+package require TclCurl
+
+curl::transfer -url 127.0.0.1 -referer "127.0.0.1/cosa.html" 	\
+        -verbose 1 -nobody 1
+
+
+
+
+

tests/reset.tcl

@@ -0,0 +1,21 @@
+package require TclCurl
+
+set curlHandle [curl::init]
+
+puts "First we save in 'index.html'"
+
+$curlHandle configure -noprogress  1 -url "127.0.0.1" -file "index.html"
+$curlHandle perform
+
+puts "And now in stdout"
+
+$curlHandle reset
+$curlHandle configure -url "http://127.0.0.1/"
+$curlHandle perform
+
+$curlHandle cleanup
+
+
+
+
+

tests/resume.tcl

@@ -0,0 +1,8 @@
+package require TclCurl
+
+curl::transfer -url 127.0.0.1 -resumefrom 500
+
+
+
+
+

tests/share.tcl

@@ -0,0 +1,23 @@
+# The share interface support is not yet completely done, since
+# you can't use it with the multi interface.
+
+package require TclCurl
+
+set sHandle [curl::shareinit]
+$sHandle share dns
+
+set easyHandle1 [curl::init]
+set easyHandle2 [curl::init]
+
+$easyHandle1 configure -url http://127.0.0.1/         -share $sHandle
+$easyHandle2 configure -url http://127.0.0.1/~andres/ -share $sHandle
+
+$easyHandle1 perform
+$easyHandle2 perform
+
+$easyHandle1 cleanup
+$easyHandle2 cleanup
+
+$sHandle unshare dns
+$sHandle cleanup
+

tests/smtp.tcl

@@ -0,0 +1,52 @@
+package require TclCurl
+
+# As an example this is contrived, but it works.
+
+set alreadySent 0
+set mailToSend \
+"Date: Mon, 12 Sep 2011 20:34:29 +0200
+To: fandom@telefonica.net
+From: andres@verot.com
+Subject: SMTP example
+
+The body of the message starts here.
+
+It could be a lot of lines, could be MIME encoded, whatever.
+Check RFC5322.
+"
+
+proc sendString {size} {
+    global alreadySent mailToSend
+    
+    set toSend       [string range $mailToSend $alreadySent [incr $alreadySent $size]]
+    
+    incr alreadySent [string length $toSend]
+
+    return $toSend
+}
+
+set curlHandle [curl::init]
+
+$curlHandle configure -url "smtp://smtp.telefonica.net:25"
+
+$curlHandle configure -username "fandom\$telefonica.net"
+$curlHandle configure -password "XXXXXXXX"
+
+$curlHandle configure -mailfrom "fandom@telefonica.net"
+$curlHandle configure -mailrcpt [list "fandom@telefonica.net" "andresgarci@telefonica.net"]
+
+# You could put the mail in a file and use the '-infile' option
+$curlHandle configure -readproc sendString
+
+$curlHandle configure -verbose 1
+
+$curlHandle perform
+
+$curlHandle cleanup
+
+
+
+
+
+
+

tests/stderrNoStderr.tcl

@@ -0,0 +1,22 @@
+package require TclCurl
+
+set curlHandle [curl::init]
+
+puts "First it goes into error.txt"
+$curlHandle configure -url  127.0.0.1/~andres/cosa&co.tar -stderr error.txt \
+        -noprogress 0 -file cosa.tar
+
+catch {$curlHandle perform}
+
+
+puts "And then to stderr:"
+$curlHandle configure -stderr ""
+
+catch {$curlHandle perform}
+
+$curlHandle cleanup
+
+
+
+
+

tests/strerror.tcl

@@ -0,0 +1,14 @@
+package require TclCurl
+
+puts "The error string for code 6 is '[curl::easystrerror 6]'"
+
+puts "If the number is too big: '[curl::easystrerror 2000]'"
+
+puts "It works the same way for the multi interface: '[curl::multistrerror 1]'"
+puts "And the share interface: '[curl::sharestrerror 1]'"
+
+catch {curl::easystrerror frelled} errorMsg
+puts "And if we use a nonsensical code: '$errorMsg'"
+
+catch {curl::sharestrerror} errorMsg
+puts "And if we forget the error code:\n    '$errorMsg'"

tests/timeout.tcl

@@ -0,0 +1,8 @@
+package require TclCurl
+
+curl::transfer -timeout 0 -url 127.0.0.1
+
+
+
+
+

tests/transfer.tcl

@@ -0,0 +1,47 @@
+package require TclCurl
+
+curl::transfer -url "127.0.0.1" -filetime 1                                  \
+        -infoeffectiveurl    effectiveUrl  -inforesponsecode    httpCode     \
+        -infofiletime        fileTime      -infototaltime       totalTime    \
+        -infonamelookuptime  nameLookUpTime                                  \
+        -infoconnecttime     connectTime   -infopretransfertime preTime      \
+        -infostarttransfertime startTransferTime                             \
+        -infosizeupload      sizeUpload    -infosizedownload    sizeDownload \
+        -infospeeddownload   speedDownload -infospeedupload     speedUpload  \
+        -infoheadersize      headerSize    -inforequestsize     requestSize  \
+        -infosslverifyresult sslVerifyResult                                 \
+        -infocontentlengthupload  contentLengthUpload                        \
+        -infocontentlengthdownload contentLengthDownload                     \
+        -infocontenttype     contentType                                     \
+        -inforedirecttime    redirectTime                                    \
+        -inforedirectcount   redirectCount
+
+
+puts "Url: $effectiveUrl"
+puts "Response code: $httpCode"
+puts "Filetime: $fileTime - [clock format $fileTime]"
+puts "Total time: $totalTime"
+puts "Name lookup time: $nameLookUpTime"
+puts "Name connect time: $connectTime"
+puts "Name pretransfer time: $preTime"
+puts "Name start transfer time: $startTransferTime"
+puts "Name size upload: $sizeUpload"
+puts "Name size download: $sizeDownload"
+puts "Name speed download: $speedDownload"
+puts "Name speed upload: $speedUpload"
+puts "Name header size: $headerSize"
+puts "Name request size: $requestSize"
+puts "Name ssl verifyresult: $sslVerifyResult"
+puts "Name length download: $contentLengthDownload"
+puts "Name length upload: $contentLengthUpload"
+puts "Content-Type: $contentType"
+puts "Redirect time: $redirectTime"
+puts "Redirect count: $redirectCount"
+
+
+
+
+
+
+
+

tests/upload.tcl

@@ -0,0 +1,8 @@
+package require TclCurl
+
+
+curl::transfer -url ftp://andres:ciclope4@127.0.01/cosa.tcl                 \
+        -infilesize [file size writeProc.tcl] -infile writeProc.tcl -upload 1 \
+        -verbose 1
+
+

tests/userAgent.tcl

@@ -0,0 +1,11 @@
+package require TclCurl
+
+curl::transfer -url "127.0.0.1" -verbose 1 -nobody 1 \
+        -useragent "Mozilla 4.0 (compatible; Getleft 0.10.4)"
+
+
+
+
+
+
+

tests/verbose.tcl

@@ -0,0 +1,23 @@
+package require TclCurl
+
+set curlHandle [curl::init]
+
+$curlHandle configure -url 127.0.0.1 -verbose 1 -nobody 1
+
+
+puts "First one is verbose"
+$curlHandle perform
+
+puts "The second isn't"
+$curlHandle configure -verbose 0 
+$curlHandle perform
+
+
+$curlHandle cleanup
+
+
+
+
+
+
+

tests/version.tcl

@@ -0,0 +1,9 @@
+package require TclCurl
+
+puts "[curl::version]"
+
+
+
+
+
+

tests/versionInfo.tcl

@@ -0,0 +1,13 @@
+package require TclCurl
+
+
+puts "Version [curl::versioninfo -version]"
+puts "Version (num): [curl::versioninfo -versionnum]"
+puts "Host: [curl::versioninfo -host]"
+puts "Features: [curl::versioninfo -features]"
+puts "SSL version: [curl::versioninfo -sslversion]"
+puts "SSL version (num): [curl::versioninfo -sslversionnum]"
+puts "libz version: [curl::versioninfo -libzversion]"
+puts "Protocols [curl::versioninfo -protocols]"
+
+

tests/writeHeader.tcl

@@ -0,0 +1,9 @@
+package require TclCurl
+
+curl::transfer -url 127.0.0.1 -header 1 -nobody 1 \
+        -writeheader header.txt
+
+
+
+
+

tests/writeProc.tcl

@@ -0,0 +1,23 @@
+package require TclCurl
+
+# This is one contrived example, but it works.
+
+proc writeToFile {readData} {
+    puts "writeToFile called [incr ::i]"
+    puts -nonewline $::outFile $readData
+
+    return
+}
+
+set i 0
+
+set outFile [open "cosa.tar" w+]
+fconfigure $outFile -translation binary
+
+curl::transfer -url "127.0.0.1/~andres/cosa&co.tar" -writeproc writeToFile
+
+close $outFile
+
+
+
+