Fossil

Check-in [2b9c6df4]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:tclfossil: initial directory structure and package split up
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tclfossil-1
Files: files | file ages | folders
SHA1:2b9c6df430776725bde3d45e0bdbbcb3c1f29548
User & Date: mjanssen 2008-02-19 18:05:51
Context
2008-02-19
21:58
tclfossil: added schema command Closed-Leaf check-in: 8c4b5300 user: mjanssen tags: tclfossil-1
18:05
tclfossil: initial directory structure and package split up check-in: 2b9c6df4 user: mjanssen tags: tclfossil-1
2008-02-17
00:31
tclfossil: initial version of clone that can get first igots check-in: 60b40f29 user: mjanssen tags: tclfossil-1
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Deleted tools/tclfossil/clone.tcl.

     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         -

Deleted tools/tclfossil/lib/tf_db.tcl.

     1         -package require Tcl 8.5
     2         -package require sqlite3
     3         -package require snit
     4         -
     5         -snit::type ::vc::fossil::db {
     6         -    variable db
     7         -    method open_repository {{name {}}} {
     8         -	sqlite3 db1 c:/src/fossil.fsl
     9         -        set db db1
    10         -    }
    11         -    method revlist {} {
    12         -	$db eval {select uuid from blob}
    13         -    }
    14         -}
    15         -
    16         -vc::fossil::db create fossildb
    17         -
    18         -fossildb open_repository
    19         -puts [fossildb revlist]

Added tools/tclfossil/lib/vc/fossil/blob-1.0.tm.

            1  +## -*- tcl -*-
            2  +# # ## ### ##### ######## ############# #####################
            3  +## Copyright (c) 2008 Mark Janssen.
            4  +#
            5  +# This software is licensed as described in the file LICENSE, which
            6  +# you should have received as part of this distribution.
            7  +#
            8  +# This software consists of voluntary contributions made by many
            9  +# individuals.  For exact contribution history, see the revision
           10  +# history and logs, available at http://fossil-scm.hwaci.com/fossil
           11  +# # ## ### ##### ######## ############# #####################
           12  +
           13  +## Commands for creating and managing fossil blobs.
           14  +
           15  +# # ## ### ##### ######## ############# #####################
           16  +## Requirements
           17  +
           18  +package require Tcl 8.5                             ; # Required runtime.
           19  +package require sqlite3                             ; # Fossil database access
           20  +package require snit                                ; # OO system.
           21  +package require zlib
           22  +
           23  +package provide vc::fossil::blob 1.0
           24  +
           25  +# # ## ### ##### ######## ############# #####################
           26  +##
           27  +
           28  +namespace eval ::vc::fossil {
           29  +    namespace export blob
           30  +    snit::type blob {
           31  +	option -data ""
           32  +
           33  +	constructor {args} {
           34  +	    $self configurelist $args
           35  +	}
           36  +
           37  +	method compress {} {
           38  +	    set data [$self cget -data]
           39  +	    set n [string length $data]
           40  +	    set data [zlib compress $data 9]
           41  +	    set header [binary format I $n]
           42  +	    return $header$data
           43  +	}
           44  +
           45  +	method  decompress {} {
           46  +	    set data [$self cget -data]
           47  +	    binary scan $data I length
           48  +	    return [zlib decompress [string range $data 4 end] $length ]
           49  +	} 
           50  +    }
           51  +}
           52  +

Added tools/tclfossil/lib/vc/fossil/cmd-1.0.tm.

            1  +## -*- tcl -*-
            2  +# # ## ### ##### ######## ############# #####################
            3  +## Copyright (c) 2008 Mark Janssen.
            4  +#
            5  +# This software is licensed as described in the file LICENSE, which
            6  +# you should have received as part of this distribution.
            7  +#
            8  +# This software consists of voluntary contributions made by many
            9  +# individuals.  For exact contribution history, see the revision
           10  +# history and logs, available at http://fossil-scm.hwaci.com/fossil
           11  +# # ## ### ##### ######## ############# #####################
           12  +
           13  +## Fossil subcommand managment.
           14  +
           15  +# # ## ### ##### ######## ############# #####################
           16  +## Requirements
           17  +
           18  +package require Tcl 8.5                             ; # Required runtime.
           19  +package require sqlite3                             ; # Fossil database access
           20  +package require snit                                ; # OO system.
           21  +
           22  +
           23  +package provide vc::fossil::cmd 1.0
           24  +
           25  +# # ## ### ##### ######## ############# #####################
           26  +##
           27  +
           28  +namespace eval ::vc::fossil {
           29  +    namespace export cmd
           30  +    snit::type cmd {
           31  +	typevariable commands ""
           32  +
           33  +	typemethod add {command} {
           34  +	    lappend commands $command
           35  +	    
           36  +	}
           37  +	
           38  +	typemethod list {} {
           39  +	    return $commands
           40  +	}
           41  +    }
           42  +}
           43  +

Added tools/tclfossil/lib/vc/fossil/cmd/clone-1.0.tm.

            1  +## -*- tcl -*-
            2  +# # ## ### ##### ######## ############# #####################
            3  +## Copyright (c) 2008 Mark Janssen.
            4  +#
            5  +# This software is licensed as described in the file LICENSE, which
            6  +# you should have received as part of this distribution.
            7  +#
            8  +# This software consists of voluntary contributions made by many
            9  +# individuals.  For exact contribution history, see the revision
           10  +# history and logs, available at http://fossil-scm.hwaci.com/fossil
           11  +# # ## ### ##### ######## ############# #####################
           12  +
           13  +
           14  +# # ## ### ##### ######## ############# #####################
           15  +## Requirements
           16  +
           17  +package require Tcl 8.5                             ; # Required runtime.
           18  +package require snit                                ; # OO system.
           19  +package require vc::fossil::cmd 1.0                 ; # Subcommand management
           20  +package require vc::fossil::blob 1.0
           21  +                
           22  +package provide vc::fossil::cmd::clone 1.0
           23  +
           24  +# # ## ### ##### ######## ############# #####################
           25  +## Imports
           26  +
           27  +namespace import ::vc::fossil::blob
           28  +
           29  +
           30  +# # ## ### ##### ######## ############# #####################
           31  +##
           32  +
           33  +vc::fossil::cmd add clone
           34  +
           35  +namespace eval ::vc::fossil::cmd {
           36  +    proc clone {args} {
           37  +	if {[ui argc] != 4} {
           38  +	    ui usage "FILE-OR-URL NEW-REPOSITORY"
           39  +	}
           40  +	
           41  +	set local_file [lindex [ui argv] 3]
           42  +	if {[file exists $local_file]} {
           43  +	    ui panic "file already exists: $local_file"
           44  +	}
           45  +	puts "cloning: $args"
           46  +	package require http
           47  +	package require sha1
           48  +	package require autoproxy
           49  +
           50  +	autoproxy::init
           51  +	puts [autoproxy::configure]
           52  +
           53  +	proc login_card {userid password message} {
           54  +	    # calculates the login card for the specific user for this msg
           55  +
           56  +	    set nonce [sha1::sha1 -hex $message]
           57  +	    set signature [sha1::sha1 -hex $nonce$password]
           58  +	    return "login $userid $nonce $signature\n"
           59  +	}
           60  +
           61  +	proc http_req {url user password message} {
           62  +	    set login_card [login_card $user $password $message]
           63  +	    blob blob_a -data $login_card$message
           64  +	    set message [blob_a compress]
           65  +	    blob_a destroy
           66  +	    return [http::geturl $url/xfer -binary 1 -query $message -type application/x-fossil]
           67  +	}
           68  +
           69  +
           70  +	set tok [http_req http://www.fossil-scm.org/fossil MJanssen {} clone\n]
           71  +	http::wait $tok
           72  +	set zip_body  [http::data $tok]
           73  +	blob blob_a -data $zip_body
           74  +	set body [blob_a decompress]
           75  +	blob_a destroy
           76  +	set lines [split $body \n] 
           77  +	puts $body
           78  +	puts "Received:\t[string length $body] ([string length $zip_body]) bytes,\t[llength $lines] messages"
           79  +
           80  +
           81  +    }
           82  +}

Added tools/tclfossil/lib/vc/fossil/db-1.0.tm.

            1  +package require Tcl 8.5
            2  +package require sqlite3
            3  +package require snit
            4  +
            5  +snit::type ::vc::fossil::db {
            6  +    variable db
            7  +    method open_repository {{name {}}} {
            8  +	sqlite3 db1 c:/src/fossil.fsl
            9  +        set db db1
           10  +    }
           11  +    method revlist {} {
           12  +	$db eval {select uuid from blob}
           13  +    }
           14  +}
           15  +
           16  +vc::fossil::db create fossildb
           17  +
           18  +fossildb open_repository
           19  +puts [fossildb revlist]

Added tools/tclfossil/lib/vc/fossil/ui-1.0.tm.

            1  +## -*- tcl -*-
            2  +# # ## ### ##### ######## ############# #####################
            3  +## Copyright (c) 2008 Mark Janssen.
            4  +#
            5  +# This software is licensed as described in the file LICENSE, which
            6  +# you should have received as part of this distribution.
            7  +#
            8  +# This software consists of voluntary contributions made by many
            9  +# individuals.  For exact contribution history, see the revision
           10  +# history and logs, available at http://fossil-scm.hwaci.com/fossil
           11  +# # ## ### ##### ######## ############# #####################
           12  +
           13  +## Command line user interface for tclfossil.
           14  +
           15  +# # ## ### ##### ######## ############# #####################
           16  +## Requirements
           17  +
           18  +package require Tcl 8.5                             ; # Required runtime.
           19  +package require snit                                ; # OO system.
           20  +package require vc::fossil::cmd::clone 1.0          ; # Clone command
           21  +
           22  +package provide vc::fossil::ui 1.0
           23  +
           24  +# # ## ### ##### ######## ############# #####################
           25  +##
           26  +
           27  +namespace eval ::vc::fossil {
           28  +    snit::type ui {
           29  +	typevariable argv
           30  +	typevariable argc
           31  +	typevariable command
           32  +	typevariable fSqlTrace
           33  +	typevariable fUser
           34  +
           35  +	typemethod run {args} {
           36  +	    
           37  +	    # TODO parse options
           38  +	    set argv $args
           39  +	    set argc [llength $args]
           40  +
           41  +	    if {$argc < 2} {
           42  +		ui usage "COMMAND ..."
           43  +	    }
           44  +
           45  +	    # TODO better command searching so prefixes work
           46  +	    set command [lindex $argv 1]
           47  +	    set commands [vc::fossil::cmd list]
           48  +	       
           49  +	    if {[lsearch $commands $command] < 0} {
           50  +		puts "unknown command: $command"
           51  +		puts {use "help" for more information}
           52  +		exit 1
           53  +	    }
           54  +	    vc::fossil::cmd::$command {*}[lrange $argv 1 end]
           55  +	    return
           56  +	}
           57  +	
           58  +	typemethod usage {str} {
           59  +	    puts stderr "Usage: [lrange $argv 0 1] $str"
           60  +	    exit 1
           61  +	}
           62  +	
           63  +	typemethod panic {str} {
           64  +	    puts stderr "[lindex $argv 0]: $str"
           65  +	    exit 1
           66  +	}
           67  +	    
           68  +	
           69  +	typemethod argc {} {
           70  +	    return $argc
           71  +	}
           72  +
           73  +	typemethod argv {} {
           74  +	    return $argv
           75  +	}
           76  +    }
           77  +}

Added tools/tclfossil/tf.

            1  +#!/bin/sh
            2  +## -*- tcl -*- \
            3  +exec tclsh "$0" ${1+"$@"}
            4  +
            5  +# # ## ### ##### ######## ############# #####################
            6  +## Copyright (c) 2008 Mark Janssen.
            7  +#
            8  +# This software is licensed as described in the file LICENSE, which
            9  +# you should have received as part of this distribution.
           10  +#
           11  +# This software consists of voluntary contributions made by many
           12  +# individuals.  For exact contribution history, see the revision
           13  +# history and logs, available at http://fossil-scm.hwaci.com/fossil
           14  +# # ## ### ##### ######## ############# #####################
           15  +
           16  +## Command line application wrapped around the import packages.
           17  +
           18  +# # ## ### ##### ######## ############# #####################
           19  +## Requirements, extended package management for local packages.
           20  +
           21  +::tcl::tm::path add [file normalize [file join [file dirname [info script]] lib]]
           22  +
           23  +package require Tcl 8.5                 ; # Required runtime.
           24  +package require vc::fossil::ui          ; # Main functionality.
           25  +
           26  +# # ## ### ##### ######## ############# #####################
           27  +## Execution
           28  +
           29  +vc::fossil::ui run $::argv0 {*}$argv
           30  +exit 0
           31  +
           32  +# # ## ### ##### ######## ############# #####################