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 Unified Diffs Show Whitespace Changes Patch

Deleted tools/tclfossil/clone.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
package require http
package require zlib
package require sha1

proc login_card {userid password message} {
   # calculates the login card for the specific user for this msg

   set nonce [sha1::sha1 -hex $message]
   set signature [sha1::sha1 -hex $nonce$password]
   return "login $userid $nonce $signature\n"
}

proc http_req {url user password message} {
  set login_card [login_card $user $password $message]
  set message [blob_compress "$login_card$message"]
  return [http::geturl $url/xfer -binary 1 -query $message -type application/x-fossil]
}


proc blob_compress {data} {
    set n [string length $data]
    set data [zlib compress $data 9]
    set header [binary format I $n]
    
    return $header$data
}

proc blob_decompress {data} {
    binary scan $data I length
    return [zlib decompress [string range $data 4 end] $length ]
} 

# send buffer starts with 4 bytes (big endian) containing the length of the blob


set tok [http_req http://www.fossil-scm.org/fossil MJanssen {} clone\n]
http::wait $tok
set body [blob_decompress [http::data $tok]] 
set lines [split $body \n] 
puts $body
puts "Received:\t[string length $body] bytes,\t[llength $lines] messages"

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




















































































Deleted tools/tclfossil/lib/tf_db.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
package require Tcl 8.5
package require sqlite3
package require snit

snit::type ::vc::fossil::db {
    variable db
    method open_repository {{name {}}} {
	sqlite3 db1 c:/src/fossil.fsl
        set db db1
    }
    method revlist {} {
	$db eval {select uuid from blob}
    }
}

vc::fossil::db create fossildb

fossildb open_repository
puts [fossildb revlist]
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






































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









































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2008 Mark Janssen.
#
# This software is licensed as described in the file LICENSE, which
# you should have received as part of this distribution.
#
# This software consists of voluntary contributions made by many
# individuals.  For exact contribution history, see the revision
# history and logs, available at http://fossil-scm.hwaci.com/fossil
# # ## ### ##### ######## ############# #####################

## Commands for creating and managing fossil blobs.

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.5                             ; # Required runtime.
package require sqlite3                             ; # Fossil database access
package require snit                                ; # OO system.
package require zlib

package provide vc::fossil::blob 1.0

# # ## ### ##### ######## ############# #####################
##

namespace eval ::vc::fossil {
    namespace export blob
    snit::type blob {
	option -data ""

	constructor {args} {
	    $self configurelist $args
	}

	method compress {} {
	    set data [$self cget -data]
	    set n [string length $data]
	    set data [zlib compress $data 9]
	    set header [binary format I $n]
	    return $header$data
	}

	method  decompress {} {
	    set data [$self cget -data]
	    binary scan $data I length
	    return [zlib decompress [string range $data 4 end] $length ]
	} 
    }
}

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























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2008 Mark Janssen.
#
# This software is licensed as described in the file LICENSE, which
# you should have received as part of this distribution.
#
# This software consists of voluntary contributions made by many
# individuals.  For exact contribution history, see the revision
# history and logs, available at http://fossil-scm.hwaci.com/fossil
# # ## ### ##### ######## ############# #####################

## Fossil subcommand managment.

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.5                             ; # Required runtime.
package require sqlite3                             ; # Fossil database access
package require snit                                ; # OO system.


package provide vc::fossil::cmd 1.0

# # ## ### ##### ######## ############# #####################
##

namespace eval ::vc::fossil {
    namespace export cmd
    snit::type cmd {
	typevariable commands ""

	typemethod add {command} {
	    lappend commands $command
	    
	}
	
	typemethod list {} {
	    return $commands
	}
    }
}

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





































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2008 Mark Janssen.
#
# This software is licensed as described in the file LICENSE, which
# you should have received as part of this distribution.
#
# This software consists of voluntary contributions made by many
# individuals.  For exact contribution history, see the revision
# history and logs, available at http://fossil-scm.hwaci.com/fossil
# # ## ### ##### ######## ############# #####################


# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.5                             ; # Required runtime.
package require snit                                ; # OO system.
package require vc::fossil::cmd 1.0                 ; # Subcommand management
package require vc::fossil::blob 1.0
                
package provide vc::fossil::cmd::clone 1.0

# # ## ### ##### ######## ############# #####################
## Imports

namespace import ::vc::fossil::blob


# # ## ### ##### ######## ############# #####################
##

vc::fossil::cmd add clone

namespace eval ::vc::fossil::cmd {
    proc clone {args} {
	if {[ui argc] != 4} {
	    ui usage "FILE-OR-URL NEW-REPOSITORY"
	}
	
	set local_file [lindex [ui argv] 3]
	if {[file exists $local_file]} {
	    ui panic "file already exists: $local_file"
	}
	puts "cloning: $args"
	package require http
	package require sha1
	package require autoproxy

	autoproxy::init
	puts [autoproxy::configure]

	proc login_card {userid password message} {
	    # calculates the login card for the specific user for this msg

	    set nonce [sha1::sha1 -hex $message]
	    set signature [sha1::sha1 -hex $nonce$password]
	    return "login $userid $nonce $signature\n"
	}

	proc http_req {url user password message} {
	    set login_card [login_card $user $password $message]
	    blob blob_a -data $login_card$message
	    set message [blob_a compress]
	    blob_a destroy
	    return [http::geturl $url/xfer -binary 1 -query $message -type application/x-fossil]
	}


	set tok [http_req http://www.fossil-scm.org/fossil MJanssen {} clone\n]
	http::wait $tok
	set zip_body  [http::data $tok]
	blob blob_a -data $zip_body
	set body [blob_a decompress]
	blob_a destroy
	set lines [split $body \n] 
	puts $body
	puts "Received:\t[string length $body] ([string length $zip_body]) bytes,\t[llength $lines] messages"


    }
}

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







































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
package require Tcl 8.5
package require sqlite3
package require snit

snit::type ::vc::fossil::db {
    variable db
    method open_repository {{name {}}} {
	sqlite3 db1 c:/src/fossil.fsl
        set db db1
    }
    method revlist {} {
	$db eval {select uuid from blob}
    }
}

vc::fossil::db create fossildb

fossildb open_repository
puts [fossildb revlist]

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



























































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2008 Mark Janssen.
#
# This software is licensed as described in the file LICENSE, which
# you should have received as part of this distribution.
#
# This software consists of voluntary contributions made by many
# individuals.  For exact contribution history, see the revision
# history and logs, available at http://fossil-scm.hwaci.com/fossil
# # ## ### ##### ######## ############# #####################

## Command line user interface for tclfossil.

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.5                             ; # Required runtime.
package require snit                                ; # OO system.
package require vc::fossil::cmd::clone 1.0          ; # Clone command

package provide vc::fossil::ui 1.0

# # ## ### ##### ######## ############# #####################
##

namespace eval ::vc::fossil {
    snit::type ui {
	typevariable argv
	typevariable argc
	typevariable command
	typevariable fSqlTrace
	typevariable fUser

	typemethod run {args} {
	    
	    # TODO parse options
	    set argv $args
	    set argc [llength $args]

	    if {$argc < 2} {
		ui usage "COMMAND ..."
	    }

	    # TODO better command searching so prefixes work
	    set command [lindex $argv 1]
	    set commands [vc::fossil::cmd list]
	       
	    if {[lsearch $commands $command] < 0} {
		puts "unknown command: $command"
		puts {use "help" for more information}
		exit 1
	    }
	    vc::fossil::cmd::$command {*}[lrange $argv 1 end]
	    return
	}
	
	typemethod usage {str} {
	    puts stderr "Usage: [lrange $argv 0 1] $str"
	    exit 1
	}
	
	typemethod panic {str} {
	    puts stderr "[lindex $argv 0]: $str"
	    exit 1
	}
	    
	
	typemethod argc {} {
	    return $argc
	}

	typemethod argv {} {
	    return $argv
	}
    }
}

Added tools/tclfossil/tf.

































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#!/bin/sh
## -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}

# # ## ### ##### ######## ############# #####################
## Copyright (c) 2008 Mark Janssen.
#
# This software is licensed as described in the file LICENSE, which
# you should have received as part of this distribution.
#
# This software consists of voluntary contributions made by many
# individuals.  For exact contribution history, see the revision
# history and logs, available at http://fossil-scm.hwaci.com/fossil
# # ## ### ##### ######## ############# #####################

## Command line application wrapped around the import packages.

# # ## ### ##### ######## ############# #####################
## Requirements, extended package management for local packages.

::tcl::tm::path add [file normalize [file join [file dirname [info script]] lib]]

package require Tcl 8.5                 ; # Required runtime.
package require vc::fossil::ui          ; # Main functionality.

# # ## ### ##### ######## ############# #####################
## Execution

vc::fossil::ui run $::argv0 {*}$argv
exit 0

# # ## ### ##### ######## ############# #####################