Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'

13 files changed, 280 insertions, 0 deletions

diff --git a/tcllib/examples/transfer/certs/README.txt b/tcllib/examples/transfer/certs/README.txt
new file mode 100644
index 0000000..082c659
--- /dev/null
+++ b/tcllib/examples/transfer/certs/README.txt
@@ -0,0 +1,3 @@
+These certificates have been created with SimpleCA,
+see http://wiki.tcl.tk/11419
+and http://users.skynet.be/ballet/joris/SimpleCA/
diff --git a/tcllib/examples/transfer/certs/ca.crt b/tcllib/examples/transfer/certs/ca.crt
new file mode 100644
index 0000000..28a3705
--- /dev/null
+++ b/tcllib/examples/transfer/certs/ca.crt
@@ -0,0 +1,17 @@
+-----BEGIN CERTIFICATE-----
+MIICtDCCAh2gAwIBAgIJAKWjOP4GKWjhMA0GCSqGSIb3DQEBBAUAMIGBMQswCQYD
+VQQGEwJDQTELMAkGA1UECBMCQkMxEjAQBgNVBAcTCVZhbmNvdXZlcjEMMAoGA1UE
+ChMDVENBMQ8wDQYDVQQLEwZUY2xsaWIxFzAVBgNVBAMTDlRjbGxpYiBSb290IENB
+MRkwFwYJKoZIhvcNAQkBFgp0Y2xsaWJAdGNhMB4XDTEzMDEyMTIxNDUyOFoXDTIz
+MDEyOTIxNDUyOFowgYExCzAJBgNVBAYTAkNBMQswCQYDVQQIEwJCQzESMBAGA1UE
+BxMJVmFuY291dmVyMQwwCgYDVQQKEwNUQ0ExDzANBgNVBAsTBlRjbGxpYjEXMBUG
+A1UEAxMOVGNsbGliIFJvb3QgQ0ExGTAXBgkqhkiG9w0BCQEWCnRjbGxpYkB0Y2Ew
+gZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJAoGBALda0hrGvGLuaLICFkkwiz0AvDqK
+fFsc1nNw4A9FcQ8cpA2SMeoKLyBLANLxrn99eboSCvW+XADZ8u7uwPU2/rnLmqaZ
+mGZXA2jCKMVK6yxvbXvw2oYQGUN3xYhSQtEaYOoGrjn1HpkMpDJmx4TCCwMpwZmh
+I95MCZtwvnSEGJQvAgMBAAGjMjAwMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYE
+FCHaYPrHbeAAAjyHQIo1129sS+ElMA0GCSqGSIb3DQEBBAUAA4GBAEMba535SbVo
+wZRim/hZbH97WoWNvGA+GuEyiVvae4TQaOpFVAOxwU/l0K6qXumIs8XTCdUh9T6P
+T3TOxzVL7wHRQf8QR7buZEGooss/3Nw9lZmSJbfuxg2z0qG8r6FqhnDmNK0yimBt
+VmuLWF+l8gb0lBYCEZdP0AMGT6UdE5J8
+-----END CERTIFICATE-----
diff --git a/tcllib/examples/transfer/certs/ca.key b/tcllib/examples/transfer/certs/ca.key
new file mode 100644
index 0000000..99b1460
--- /dev/null
+++ b/tcllib/examples/transfer/certs/ca.key
@@ -0,0 +1,18 @@
+-----BEGIN RSA PRIVATE KEY-----
+Proc-Type: 4,ENCRYPTED
+DEK-Info: DES-EDE3-CBC,DD33F28636691816
+
+3NQhYUEuaz6bTuf3NsjybmwqfTFPdlBsX2FAn/p7lCQdbAOtSjQbcs1aC2eohfb6
+s9o7GRMMJXOH8tMr5BueSl4fBoXalsumDU0WVt/gg2vfC4js+vbgxjV6/lqhrvE2
+E442GQIQUlcO9Zs7nGATuBGWxhgW9zCZys+lTYlU33751fGIaTlIECwuxWJ/rLdJ
+73MeRNH1Qi9pcPCuRmK/oOZsH0jAlMiLLrAzLx/VOB5e8cip14rjGyxh8M3a//Fv
+GIO4fUD6++1FQJLl39dNNVAjCsaVCyT/R82fBrhYD/JZrh/rLGD96UyIwr9AE/PW
+XySZ2YoUvwImQGdQxLSnE0x+MtxPwt5iNXr586jB2Wz1G8fjYPNDz4tUkM/8iUVi
+I/Pn8JyErul9AVZqQkSCoytrmqajMO9xZAym+R8qgvqkQuSZL2MwPgNZRJ5H01kC
+Z1xRw2jNobSOPyBEG03TOBpXHKayzpIdqEx7ZUuG2FLa1uTicmVnwyuE6jQCgMo3
+wTNrLCzeNJgNggk4XaSzMqy1zAltBx/Q3aPbrspKt1JvAboFu/+TJBwfi/Gk+MT1
+RBWUB6d/4YsnW+6mx/68TlL9TVDnvSzkW8/EW/JrCL5mAJYjN4c5/0++Qu/8g6d/
+icy7g4gz0JaEN7s0jh6lPWlYC+2cj9d3vB3uY2j+9KsUqOalr4jhSZ8sidh7T3OA
+iuQGIgrnZQgU6tZa0MeTct/zxBup4r1sfpyuYYWatkD0QTejH4rzKASWAQD81mOs
+0wzxdS10/kCjzXrh/5EDq5B1wiD506/PpRXej/l8oxHqhNE338YlSQ==
+-----END RSA PRIVATE KEY-----
diff --git a/tcllib/examples/transfer/certs/ca.key.password b/tcllib/examples/transfer/certs/ca.key.password
new file mode 100644
index 0000000..faddeb7
--- /dev/null
+++ b/tcllib/examples/transfer/certs/ca.key.password
@@ -0,0 +1 @@
+tcllib-devel
diff --git a/tcllib/examples/transfer/certs/receiver.crt b/tcllib/examples/transfer/certs/receiver.crt
new file mode 100644
index 0000000..80c4e59
--- /dev/null
+++ b/tcllib/examples/transfer/certs/receiver.crt
@@ -0,0 +1,18 @@
+-----BEGIN CERTIFICATE-----
+MIIC4TCCAkqgAwIBAgICEAEwDQYJKoZIhvcNAQEEBQAwgYExCzAJBgNVBAYTAkNB
+MQswCQYDVQQIEwJCQzESMBAGA1UEBxMJVmFuY291dmVyMQwwCgYDVQQKEwNUQ0Ex
+DzANBgNVBAsTBlRjbGxpYjEXMBUGA1UEAxMOVGNsbGliIFJvb3QgQ0ExGTAXBgkq
+hkiG9w0BCQEWCnRjbGxpYkB0Y2EwHhcNMTMwMTIxMjE0NzAyWhcNMjMwMTE5MjE0
+NzAyWjCBgDELMAkGA1UEBhMCQ0ExCzAJBgNVBAgTAkJDMRIwEAYDVQQHEwlWYW5j
+b3V2ZXIxDDAKBgNVBAoTA1RDQTEPMA0GA1UECxMGVGNsbGliMREwDwYDVQQDEwhS
+ZWNlaXZlcjEeMBwGCSqGSIb3DQEJARYPcmVjZWl2ZXJAdGNsbGliMIGfMA0GCSqG
+SIb3DQEBAQUAA4GNADCBiQKBgQDLjgsEvpLz8n2lumW8BrQ0mhnC5sAPSAhEUP5O
+L+ePAt7j0r3gxYMQV+LkCHQIHOIcI5COoaG1kvc0EzX085ESgX2ksOeRCZ4c9mOY
+cGbXfXlk3WGbzONPVUoI8OrrlggD4Xm5nRlg7RPsATzf4qxty5t3sH0XGzGYeyto
+grvgkQIDAQABo2cwZTAfBgNVHSMEGDAWgBQh2mD6x23gAAI8h0CKNddvbEvhJTA0
+BgNVHSUELTArBggrBgEFBQcDAQYIKwYBBQUHAwIGCisGAQQBgjcKAwMGCWCGSAGG
++EIEATAMBgNVHRMBAf8EAjAAMA0GCSqGSIb3DQEBBAUAA4GBAE8ZtGhrr36XSQvM
+e3bKS5NtiDd5EdNlbYJmx6y7mGYYev5NShXtY/Zj6B2Zs/Cb5gdxKJowHHLtjFpJ
+L/7TMkuDGmXfZJOfoDo5kuJpRy6Cl0340fwhdFftMUV36COzgttvZRBoareT5ix0
+L+C7CHTyjD7J+FM8EYS09G/v5J7/
+-----END CERTIFICATE-----
diff --git a/tcllib/examples/transfer/certs/receiver.key b/tcllib/examples/transfer/certs/receiver.key
new file mode 100644
index 0000000..353e69a
--- /dev/null
+++ b/tcllib/examples/transfer/certs/receiver.key
@@ -0,0 +1,15 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIICXAIBAAKBgQDLjgsEvpLz8n2lumW8BrQ0mhnC5sAPSAhEUP5OL+ePAt7j0r3g
+xYMQV+LkCHQIHOIcI5COoaG1kvc0EzX085ESgX2ksOeRCZ4c9mOYcGbXfXlk3WGb
+zONPVUoI8OrrlggD4Xm5nRlg7RPsATzf4qxty5t3sH0XGzGYeytogrvgkQIDAQAB
+AoGAS+WmjhpQyMy9tLGPhVAqmQJsYJORQSFmk7JvX8/U0yoK2X+WdNywRcO/Qa81
+NGEwnbVVDRmPJhiqO6x+DdtTV5zZBMECXbPpoRCno6rN1y66OflD0reW1EWkjDAs
+BTZJ6jkMBYb/+A9hrO6rs9vOQSOuX78bv1EG9NzSR0kdlMECQQDngjy25H0G4s04
+/WIQ6ZxiqfF1dRoyr1qdsZ4SAEw81pr5EppkxOBmCxlFuTO19flb6vHV7ufAJ7PR
+ChtFblQVAkEA4RbA66XPbfl9JC+QfGNavMKJXqTZJhvcndtc8104HHszJ3Jo0O8P
+GK3tVrmpf3QmjkkbOxxYNIuyQTU/YAiNjQJAb8vUxf1Q4yJjOEIkOUaW3o5yq+YA
+4LkNaVl8m/TI3BhGfkEdjcwFEUIK0kC9WAGQiXLLliPohkKl8yyOPtkogQJAc/vv
+iP21tyt56m1//DiOBvoPIu+63UI6GjVw3g5I3ZQ2Nbtke1TT6Jmm1KtyxbQqMeNF
+3t2qLdlWDvfLIkcF+QJBAJGyZC3Zym+BrLn8OJ6ceCt/lPp/baKzz883r2xoUCiF
+HaJXRhbT563GYTBzFPgTmJO9AnVJBMkMM+Bt2R40JHk=
+-----END RSA PRIVATE KEY-----
diff --git a/tcllib/examples/transfer/certs/transmitter.crt b/tcllib/examples/transfer/certs/transmitter.crt
new file mode 100644
index 0000000..69c5027
--- /dev/null
+++ b/tcllib/examples/transfer/certs/transmitter.crt
@@ -0,0 +1,18 @@
+-----BEGIN CERTIFICATE-----
+MIIC5zCCAlCgAwIBAgICEAAwDQYJKoZIhvcNAQEEBQAwgYExCzAJBgNVBAYTAkNB
+MQswCQYDVQQIEwJCQzESMBAGA1UEBxMJVmFuY291dmVyMQwwCgYDVQQKEwNUQ0Ex
+DzANBgNVBAsTBlRjbGxpYjEXMBUGA1UEAxMOVGNsbGliIFJvb3QgQ0ExGTAXBgkq
+hkiG9w0BCQEWCnRjbGxpYkB0Y2EwHhcNMTMwMTIxMjE0NjUxWhcNMjMwMTE5MjE0
+NjUxWjCBhjELMAkGA1UEBhMCQ0ExCzAJBgNVBAgTAkJDMRIwEAYDVQQHEwlWYW5j
+b3V2ZXIxDDAKBgNVBAoTA1RDQTEPMA0GA1UECxMGVGNsbGliMRQwEgYDVQQDEwtU
+cmFuc21pdHRlcjEhMB8GCSqGSIb3DQEJARYSdHJhbnNtaXR0ZXJAdGNsbGliMIGf
+MA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQC3jpcKzCWtt5sKSHDXO34jO2G+DfbY
+OGrgPu/YaqzUxVxsFSyK56jBNa1GldVA+fOVO8KDX5UOc8KKlz+AhGq5YceGQ4Cj
+WTK3YHUeVOeBqszqphG2D5vlvFf2dqIUZ4N8a+Ah+5gwtCwBo7gPA+PxJFaTWRtG
+0nN4lWTLjeF9uwIDAQABo2cwZTAfBgNVHSMEGDAWgBQh2mD6x23gAAI8h0CKNddv
+bEvhJTA0BgNVHSUELTArBggrBgEFBQcDAQYIKwYBBQUHAwIGCisGAQQBgjcKAwMG
+CWCGSAGG+EIEATAMBgNVHRMBAf8EAjAAMA0GCSqGSIb3DQEBBAUAA4GBAA9Ec5V0
+wQCOSr2wz2qzWOQlw2KGtBCJaM/vckt5YJmpHIkp9cVP/tlHPG9qzG9VfQs4nOKa
+wUjZ8xVt6kKA8gWbBm3mFSsI2JhT/q77FCWoMC56d7cLqqU6D2fmC1ksNMljhJ5n
+UNgvspAEL5Txryh9VRYNRUZGjowquXXYUWht
+-----END CERTIFICATE-----
diff --git a/tcllib/examples/transfer/certs/transmitter.key b/tcllib/examples/transfer/certs/transmitter.key
new file mode 100644
index 0000000..164db5d
--- /dev/null
+++ b/tcllib/examples/transfer/certs/transmitter.key
@@ -0,0 +1,15 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIICXAIBAAKBgQC3jpcKzCWtt5sKSHDXO34jO2G+DfbYOGrgPu/YaqzUxVxsFSyK
+56jBNa1GldVA+fOVO8KDX5UOc8KKlz+AhGq5YceGQ4CjWTK3YHUeVOeBqszqphG2
+D5vlvFf2dqIUZ4N8a+Ah+5gwtCwBo7gPA+PxJFaTWRtG0nN4lWTLjeF9uwIDAQAB
+AoGAQlTp6kH5v7wg7+dbt7vNCmhUGv0q3doNbTnxLJDoIf+sNXa1YQD0L9X45xAQ
+P2nUB3LQCO+Kiu10OOcNUKEJe5WuIKGnD3BZkwyGOngJibYI8D0KXfqQRK9z2cgV
+GfsFXa5Dv1fK7vOM+zBVEJxmcsOqlHO6h8quwhRd7Kuu+/ECQQDjCTVgWgTt1Gq2
+1ph0iLns1LJbz8RPtM+7FgD1wUvixB5ItTTP5dI8j2o7dUb/ylGHnUNG4FruFGS5
+FHFgi1rDAkEAzvllogyGGsMgKLaxZHNiwQsUU8j0PI3y2EX0udLOVSvjDePbzg00
+GYx0rFM+pQUE12TQaIsykp0YCuGDB7vxqQJAKQw8K0x7Qai7Fo2cCM3Dl88o5DKf
+Uq3lNPUYfVZSaxB8TTb98myh4zMmyNM+X/brYLKNPF5J8mubfl701Li9UwJAcgo8
+k5Mu+OP2fjhbeauSCCegpaGd4RedbMju1MxwX8F0s5yO6fOgd0tKpgCgDbC8QCoO
+Iuw/i0T/kE89MS+/MQJBANIMifrdikFda4M8eGjRA/ekvZ0UD8ELgOs8eIBJZkvX
+1EAdlgtFAKvNW3dzu8uPRODQ1pKZoQSnOrMhe+sqzdo=
+-----END RSA PRIVATE KEY-----
diff --git a/tcllib/examples/transfer/receive.tcl b/tcllib/examples/transfer/receive.tcl
new file mode 100644
index 0000000..28cbf1e
--- /dev/null
+++ b/tcllib/examples/transfer/receive.tcl
@@ -0,0 +1,25 @@
+#!/usr/bin/env tclsh
+## -*- tcl -*-
+# syntax: receive FILE
+# Run this before transmit, will wait for connection.
+
+package require transfer::receiver
+
+set file [lindex $argv 0]
+
+proc OK {f args} {
+    puts "\nDone ($args) $f"
+    exit
+}
+
+proc PR {f args} {
+    puts "Progress ($args) $f"
+    return
+}
+
+transfer::receiver stream file $file {} 6789 \
+    -command  [list OK $file] \
+    -progress [list PR $file]
+
+vwait forever
+exit
diff --git a/tcllib/examples/transfer/sreceive.tcl b/tcllib/examples/transfer/sreceive.tcl
new file mode 100644
index 0000000..d72dd63
--- /dev/null
+++ b/tcllib/examples/transfer/sreceive.tcl
@@ -0,0 +1,36 @@
+#!/usr/bin/env tclsh
+## -*- tcl -*-
+# syntax: receive FILE
+# Run this before transmit, will wait for connection.
+
+set selfdir [file dirname [info script]]
+# Enable the commands below to run from a tcllib checkout
+#source $selfdir/../../modules/transfer/ddest.tcl
+#source $selfdir/../../modules/transfer/connect.tcl
+#source $selfdir/../../modules/transfer/receiver.tcl
+
+package require transfer::receiver
+package require tls
+
+set file [lindex $argv 0]
+
+proc OK {f args} {
+    puts "\nDone ($args) $f"
+    exit
+}
+
+proc PR {f args} {
+    puts "Progress ($args) $f"
+    return
+}
+
+set    type receiver
+source $selfdir/tlssetup.tcl
+
+transfer::receiver stream file $file {} 6789 \
+    -command  [list OK $file] \
+    -progress [list PR $file] \
+    -socketcmd tls::socket
+
+vwait forever
+exit
diff --git a/tcllib/examples/transfer/stransmit.tcl b/tcllib/examples/transfer/stransmit.tcl
new file mode 100644
index 0000000..e35f4db
--- /dev/null
+++ b/tcllib/examples/transfer/stransmit.tcl
@@ -0,0 +1,39 @@
+#!/usr/bin/env tclsh
+## -*- tcl -*-
+# syntax: transmit FILE ?HOST?
+# Run this after receive, it waits for our connection.
+
+set selfdir [file dirname [info script]]
+# Enable the commands below to run from a tcllib checkout
+#source $selfdir/../../modules/transfer/copyops.tcl
+#source $selfdir/../../modules/transfer/dsource.tcl
+#source $selfdir/../../modules/transfer/connect.tcl
+#source $selfdir/../../modules/transfer/transmitter.tcl
+
+package require transfer::transmitter
+package require tls
+
+set file [lindex $argv 0]
+set host [lindex $argv 1]
+if {$host eq {}} { set host localhost }
+
+proc OK {f args} {
+    puts "Done ($args) $f"
+    exit
+}
+
+proc PR {f args} {
+    puts "Progress ($args) $f"
+    return
+}
+
+set    type transmitter
+source $selfdir/tlssetup.tcl
+
+transfer::transmitter stream file $file $host 6789 \
+    -command  [list OK $file] \
+    -progress [list PR $file] \
+    -socketcmd tls::socket
+
+vwait forever
+exit
diff --git a/tcllib/examples/transfer/tlssetup.tcl b/tcllib/examples/transfer/tlssetup.tcl
new file mode 100644
index 0000000..cdf9245
--- /dev/null
+++ b/tcllib/examples/transfer/tlssetup.tcl
@@ -0,0 +1,49 @@
+# Initialization of TLS for the example applications.
+
+tls::init \
+    -keyfile  $selfdir/certs/${type}.key \
+    -certfile $selfdir/certs/${type}.crt \
+    -cafile   $selfdir/certs/ca.crt \
+    -ssl2 1    \
+    -ssl3 1    \
+    -tls1 0    \
+    -require 1 \
+    -password PWD \
+    -command  CMD
+
+proc PWD {args} {
+    puts P\t($args)
+    return $type
+}
+
+proc CMD {option args} {
+    switch -- $option {
+	error {
+	    return 1
+	}
+	info {
+	    foreach {chan major minor message} $args break
+	    puts "@ $chan ($major, $minor) = $message"
+	    return 1
+	}
+	verify {
+	    foreach {chan depth cert rc err} $args break
+	    array set c $cert
+	    puts CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+	    puts "C $chan $depth/$rc = $err"
+	    parray c
+	    puts ____________________________________________________________
+
+	    # Code to perform additional checks on the cert goes here.
+
+	    # always accept, even if rc is not 1 application
+	    # connection handler will determine what to do
+
+	    return 1
+	}
+	default  {
+	    return -code error "bad option \"$option\": must be one of error, info, or verify"
+	}
+    }
+    return
+}
diff --git a/tcllib/examples/transfer/transmit.tcl b/tcllib/examples/transfer/transmit.tcl
new file mode 100644
index 0000000..ec93812
--- /dev/null
+++ b/tcllib/examples/transfer/transmit.tcl
@@ -0,0 +1,26 @@
+#!/usr/bin/env tclsh
+## -*- tcl -*-
+# syntax: transmit FILE ?HOST?
+# Run this after receive, it waits for our connection.
+
+package require transfer::transmitter
+
+set file [lindex $argv 0]
+set host [lindex $argv 1]
+if {$host eq {}} { set host localhost }
+
+proc OK {f args} {
+    puts "Done ($args) $f"
+    exit
+}
+
+proc PR {f args} {
+    puts "Progress ($args) $f"
+    return
+}
+
+transfer::transmitter stream file $file $host 6789 \
+    -command  [list OK $file] \
+    -progress [list PR $file]
+vwait forever
+exit