Fossil SCM
tclfossil: initial version of clone that can get first igots
Commit
60b40f293ade26b87719df3d308074bcc5819ebe
Parent
1c92462c04fa3fd…
2 files changed
+42
+1
| --- a/tools/tclfossil/clone.tcl | ||
| +++ b/tools/tclfossil/clone.tcl | ||
| @@ -0,0 +1,42 @@ | ||
| 1 | +package require http | |
| 2 | +package require zlib | |
| 3 | +package require sha1 | |
| 4 | + | |
| 5 | +proc login_card {userid password message} { | |
| 6 | + # calculates the login card for the specific user for this msg | |
| 7 | + | |
| 8 | + set nonce [sha1::sha1 -hex $message] | |
| 9 | + set signature [sha1::sha1 -hex $nonce$password] | |
| 10 | + return "login $userid $nonce $signature\n" | |
| 11 | +} | |
| 12 | + | |
| 13 | +proc http_req {url user password message} { | |
| 14 | + set login_card [login_card $user $password $message] | |
| 15 | + set message [blob_compress "$login_card$message"] | |
| 16 | + return [http::geturl $url/xfer -binary 1 -query $message -type application/x-fossil] | |
| 17 | +} | |
| 18 | + | |
| 19 | + | |
| 20 | +proc blob_compress {data} { | |
| 21 | + set n [string length $data] | |
| 22 | + set data [zlib compress $data 9] | |
| 23 | + set header [binary format I $n] | |
| 24 | + | |
| 25 | + return $header$data | |
| 26 | +} | |
| 27 | + | |
| 28 | +proc blob_decompress {data} { | |
| 29 | + binary scan $data I length | |
| 30 | + return [zlib decompress [string range $data 4 end] $length ] | |
| 31 | +} | |
| 32 | + | |
| 33 | +# send buffer starts with 4 bytes (big endian) containing the length of the blob | |
| 34 | + | |
| 35 | + | |
| 36 | +set tok [http_req http://www.fossil-scm.org/fossil MJanssen {} clone\n] | |
| 37 | +http::wait $tok | |
| 38 | +set body [blob_decompress [http::data $tok]] | |
| 39 | +set lines [split $body \n] | |
| 40 | +puts $body | |
| 41 | +puts "Received:\t[string length $body] bytes,\t[llength $lines] messages" | |
| 42 | + |
| --- a/tools/tclfossil/clone.tcl | |
| +++ b/tools/tclfossil/clone.tcl | |
| @@ -0,0 +1,42 @@ | |
| --- a/tools/tclfossil/clone.tcl | |
| +++ b/tools/tclfossil/clone.tcl | |
| @@ -0,0 +1,42 @@ | |
| 1 | package require http |
| 2 | package require zlib |
| 3 | package require sha1 |
| 4 | |
| 5 | proc login_card {userid password message} { |
| 6 | # calculates the login card for the specific user for this msg |
| 7 | |
| 8 | set nonce [sha1::sha1 -hex $message] |
| 9 | set signature [sha1::sha1 -hex $nonce$password] |
| 10 | return "login $userid $nonce $signature\n" |
| 11 | } |
| 12 | |
| 13 | proc http_req {url user password message} { |
| 14 | set login_card [login_card $user $password $message] |
| 15 | set message [blob_compress "$login_card$message"] |
| 16 | return [http::geturl $url/xfer -binary 1 -query $message -type application/x-fossil] |
| 17 | } |
| 18 | |
| 19 | |
| 20 | proc blob_compress {data} { |
| 21 | set n [string length $data] |
| 22 | set data [zlib compress $data 9] |
| 23 | set header [binary format I $n] |
| 24 | |
| 25 | return $header$data |
| 26 | } |
| 27 | |
| 28 | proc blob_decompress {data} { |
| 29 | binary scan $data I length |
| 30 | return [zlib decompress [string range $data 4 end] $length ] |
| 31 | } |
| 32 | |
| 33 | # send buffer starts with 4 bytes (big endian) containing the length of the blob |
| 34 | |
| 35 | |
| 36 | set tok [http_req http://www.fossil-scm.org/fossil MJanssen {} clone\n] |
| 37 | http::wait $tok |
| 38 | set body [blob_decompress [http::data $tok]] |
| 39 | set lines [split $body \n] |
| 40 | puts $body |
| 41 | puts "Received:\t[string length $body] bytes,\t[llength $lines] messages" |
| 42 |
| --- a/tools/tclfossil/dependencies.txt | ||
| +++ b/tools/tclfossil/dependencies.txt | ||
| @@ -0,0 +1 @@ | ||
| 1 | +zlib: http://pascal.scheffers.net/software/zlib-1.1.1.tar.bz2 |
| --- a/tools/tclfossil/dependencies.txt | |
| +++ b/tools/tclfossil/dependencies.txt | |
| @@ -0,0 +1 @@ | |
| --- a/tools/tclfossil/dependencies.txt | |
| +++ b/tools/tclfossil/dependencies.txt | |
| @@ -0,0 +1 @@ | |
| 1 | zlib: http://pascal.scheffers.net/software/zlib-1.1.1.tar.bz2 |