Backup

Check-in [6cd21d9311]
Login

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

Overview
Comment:Initial checkin of the backup scripts.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:6cd21d9311bfe578262987b94c52790e004ab20f
User & Date: aku 2011-02-11 05:04:37
Context
2011-02-11
19:12
Extended "backup_sf" to allow specification of more than one repository type to rsync. In that case the destination directories are constructed from project name and repository type, the latter is used as suffix. Previous cases are unchanged, i.e. cvs is default, and using a single repository type uses just the project name for the destination directory. check-in: 4cafd464c3 user: aku tags: trunk
05:04
Initial checkin of the backup scripts. check-in: 6cd21d9311 user: aku tags: trunk
05:02
initial empty check-in check-in: a5c1233846 user: aku tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added bin/backup_fossil.























































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#!/home/aku/opt/ActiveTcl/bin/tclsh8.5
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}

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

set dst  [file normalize [lindex $argv 0]]
set argv [lrange $argv 1 end]

puts "Destination = $dst"
puts "Projects in:  $argv"

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

proc red {text} {
    return "\[01;37;41m$text\[00m"
}

proc pull {name url} {
    global trouble
    if {[catch {
	backup $name $url
    } msg]} {
	lappend trouble [list [list $name $url] $msg]
    }
    return
}

proc backup {name url} {
    global dst

    file mkdir $dst
    cd $dst

    puts "\n[red "Backing up $name @ $url"]......"

    if {![file exists $name.fossil]} {
	exec fossil clone $url $name.fossil \
	    2>@ stderr >@ stdout
    } else {
	exec fossil pull $url -R $name.fossil \
	    2>@ stderr >@ stdout
    }
    return
}

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

set trouble {}
foreach f $argv {
    source [file normalize $f]
}

puts ""
if {[llength $trouble]} {
    puts [red Troubles]\n\t[join $trouble \n\t]\n
}

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

Added bin/backup_git.

























































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#!/home/aku/opt/ActiveTcl/bin/tclsh8.5
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}

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

set dst  [file normalize [lindex $argv 0]]
set argv [lrange $argv 1 end]

puts "Destination = $dst"
puts "Projects in:  $argv"

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

proc red {text} {
    return "\[01;37;41m$text\[00m"
}

proc pull {name url} {
    global trouble
    if {[catch {
	backup $name $url
    } msg]} {
	lappend trouble [list [list $name $url] $msg]
    }
    return
}

proc backup {name url} {
    global dst

    file mkdir $dst
    cd $dst

    puts "\n[red "Backing up $name @ $url"]......"

    if {![file exists $name]} {
	exec git clone --no-checkout $url $name \
	    2>@ stderr >@ stdout
    } else {
	cd $name
	exec git fetch \
	    2>@ stderr >@ stdout
    }
    return
}

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

set trouble {}
foreach f $argv {
    source [file normalize $f]
}

puts ""
if {[llength $trouble]} {
    puts [red Troubles]\n\t[join $trouble \n\t]\n
}

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

Added bin/backup_sf.















































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#!/home/aku/opt/ActiveTcl/bin/tclsh8.5
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}

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

set dst  [file normalize [lindex $argv 0]]
set argv [lrange $argv 1 end]

puts "Destination = $dst"
puts "Projects in:  $argv"

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

proc red {text} {
    return "\[01;37;41m$text\[00m"
}

proc pull {name {rtype cvs}} {
    global trouble
    if {[catch {
	backup $name $rtype
    } msg]} {
	lappend trouble [list [list $name $rtype] $msg]
    }
    return
}

proc backup {name rtype} {
    global dst

    puts "\n[red "Backing up $rtype $name"]......"

    file mkdir $dst
    cd $dst
    file mkdir $name
    cd         $name

    # Known rtypes supported by sourceforge through their rsync service.
    # - cvs
    # - svn
    # - git
    # - hg  (mercurial)
    # - bzr (bazaar)
    # Information from
    # https://sourceforge.net/apps/trac/sourceforge/wiki#HostingwithSourceForge.net
    # (See the SCM line, and links).

    switch -exact -- $rtype {
	svn     { set root $rtype }
	default { set root ${rtype}root }
    }

    exec rsync -av rsync://${name}.${rtype}.sourceforge.net/${root}/${name}/* . \
	2>@ stderr >@ stdout
    return
}

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

set trouble {}
foreach f $argv {
    source [file normalize $f]
}

puts ""
if {[llength $trouble]} {
    puts [red Troubles]\n\t[join $trouble \n\t]\n
}

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

Added bin/backup_svn.

























































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#!/home/aku/opt/ActiveTcl/bin/tclsh8.5
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}

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

set dst  [file normalize [lindex $argv 0]]
set argv [lrange $argv 1 end]

puts "Destination = $dst"
puts "Projects in:  $argv"

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

proc red {text} {
    return "\[01;37;41m$text\[00m"
}

proc pull {name url} {
    global trouble
    if {[catch {
	backup $name $url
    } msg]} {
	lappend trouble [list [list $name $url] $msg]
    }
    return
}

proc do {args} {
    lappend args 2>@ stderr >@ stdout
    return [eval [linsert $args 0 exec]]
}

proc wf {content path} {
    set chan [open $path w]
    puts -nonewline $chan $content
    close $chan
    return
}

proc backup {name url} {
    global dst

    file mkdir $dst
    cd $dst

    puts "\n[red "Backing up $name @ $url"]......"

    set path [file normalize $name]

    # Setup where necessary
    if {![file exists $name]} {
	do svnadmin create $path
	file mkdir         $path/hooks
	wf "#!/bin/bash"   $path/hooks/pre-revprop-change
	do chmod +x        $path/hooks/pre-revprop-change
	do svnsync init file://$path $url
    }

    do svnsync sync file://$path
    return
}

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

set trouble {}
foreach f $argv {
    source [file normalize $f]
}

puts ""
if {[llength $trouble]} {
    puts [red Troubles]\n\t[join $trouble \n\t]\n
}

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

Added bin/cron_backup.sh.







































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
#!/bin/bash

# Get access to commands in non-standard paths.
#PATH=":$PATH"
#export PATH

here=$(dirname "$0")
base=$(dirname "$here")
data="$base/data"
etc="$base/etc"
log="$base/log"
bin="$base/bin"

"$bin/backup_sf"     > "$log/sourceforge.log" 2>&1 "$data/sourceforge" "$etc/backup_sourceforge"
"$bin/backup_fossil" > "$log/fossil.log"      2>&1 "$data/fossil"      "$etc/backup_fossilized"
"$bin/backup_git"    > "$log/git.log"         2>&1 "$data/git"         "$etc/backup_git"
"$bin/backup_svn"    > "$log/svn.log"         2>&1 "$data/svn"         "$etc/backup_svn"
# hg - mercurial
# bzr - bazaar

Added bin/pullsf.

















































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
#!/bin/bash

# Get access to commands in non-standard paths.
#PATH=":$PATH"
#export PATH

here=$(dirname "$0")
base=$(dirname "$here")
data="$base/data"
etc="$base/etc"
log="$base/log"
bin="$base/bin"

user=YOUR_SF_ACCOUNT
password=YOUR_SF_PASSWORD

rm "$log/pullsf.log"
for project in $(cat "$etc/pullsf")
do
    echo $project ...
    "$bin/sfpull" "$user" "$password" "$project" "$data/pullsf/$project" >> "$log/pullsf.log" 2>&1
    chown -R aku.aku "$data/pullsf/$project"
    chmod -R ugo+rw  "$data/pullsf/$project"
done

Added bin/sfpull.

























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
#!/bin/sh
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}
# ### ### ### ######### ######### #########
## (C) 2009 ActiveState Software Inc.
#
## SourceForge Pull (Extract Project information from SourceForge).
## A ForkLift application

# ### ### ### ######### ######### #########
## Usage:
##	sfpull user password project output
##
##	Extracts the information of <project> from SourceForge
##	and stores it in the directory <output>. The application
##	logs into SourceForge using the given <user/password>
##      combination, which has to be an administrator of the
##      <project>.

# ### ### ### ######### ######### #########
## NOTES ...
#
# SourceForge has three ways of authentication ...
# Really consistent. Not.
#
# (1) Project web is 'rsync over ssh' => force password, expect to
#     intercept to query, user via command line argument.
#
# (2) Mailing list archives require url get + basic authentication.
#
# (3) xml export of trackers require url + cookies, the latter we get
#     from submitting the SF login form.

# ### ### ### ######### ######### #########
## Requisites

package require Expect           ; # ssh password interaction
package require base64           ; # (Tcllib) Encoding for basic authentication.
package require fileutil         ; # (Tcllib) Helper for rsync over ssh, temp ssh config.
package require http 2.7         ; # (Core) Retrieve urls, post forms ...
package require textutil::adjust ; # (Tcllib) support for json generator code
package require tls              ; # Secure connections (https).
package require autoproxy


#puts [package ifneeded http [package present http]]
#proc http::Log {args} { puts HTTP:\ [join $args] }

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

proc main {} {
    initialize;# Required for verify_project, in the commandline.
    if {![commandline]} usage
    save_config \
	[pull_tracker] \
	[pull_mailinglists] \
	[pull_website] \
	[pull_repository]
    return
}

proc commandline {} {
    global argv
    if {[llength $argv] != 4} { return 0 }

    global theuser        ; set theuser        [lindex $argv 0]
    global thepassword    ; set thepassword    [lindex $argv 1]
    global theproject     ; set theproject     [lindex $argv 2]
    global thedestination ; set thedestination [lindex $argv 3]

    if {$theuser        eq {}} { return 0 }
    if {$thepassword    eq {}} { return 0 }
    if {$theproject     eq {}} { return 0 }
    if {$thedestination eq {}} { return 0 }

    verify_project
    return 1
}

proc usage {} {
    global argv0
    puts stderr "Usage: $argv0 user password project outputdir"
    exit 1
}

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

proc initialize {} {
    #autoproxy::init localhost:8080
    http::register https 443 tls::socket
    # Fake SF into believing that an actual browser is talking to it.
    http::config -useragent {Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13}
    return
}

proc save_config {tracker mlists website repository} {
    # tracker    = name of the tracker XML file
    # website    = name of the website directory, if any.
    # repository = name of repository directory.
    # mlists ... = lists containing the names of all project mailing
    #              lists, if any.

    global thedestination theproject thepid therepotype theuser

    set tmp {}
    foreach {name archive} $mlists {
	lappend tmp $name [JsonString $archive]
    }
    set mlists $tmp

    file mkdir $thedestination
    array set config { aligned 1 indented 1 }
    fileutil::writeFile $thedestination/Configuration \
	[JsonObject \
	     configuration-version [JsonString 1] \
	     project        [JsonString $theproject] \
	     origin         [JsonString SourceForge] \
	     origin-url     [JsonString http://sourceforge.net/projects/$theproject] \
	     origin-id      [JsonString $thepid] \
	     exporter       [JsonString $theuser] \
	     tracker        [JsonString $tracker] \
	     mailinglists   [JsonObjectDict $mlists] \
	     website        [JsonString $website] \
	     repository     [JsonObject \
				 type  [JsonString $therepotype] \
				 where [JsonString $repository] \
				] \
	     ]\n
    return
}

proc pull_tracker {} {
    global thepid

    log Retrieving tracker information...

    set src https://sourceforge.net/export/xml_export2.php?group_id=$thepid
    set dst Trackers.xml

    pull-with-cookie-login $src $dst

    return $dst
}

proc pull_mailinglists {} {
    global thepid

    log Retrieving mailing list archives...

    set token [http::geturl \
		   http://sourceforge.net/mail/?group_id=$thepid]

    #puts [http::data $token]

    set pattern "forum.php\\?forum_name=(\[^\"\]+)"
    set matches [regexp -all -inline -- $pattern [http::data $token]]
    http::cleanup $token

    set mlists {}
    foreach {dummy listname} $matches {
	lappend mlists $listname
    }

    set archives {}
    foreach listname [lsort -unique $mlists] {
	log "\t* $listname"

	set src https://lists.sourceforge.net/mbox/$listname
	set dst Mailinglists/$listname.mbox

	pull-with-basic-login $src $dst

	lappend archives $listname $dst
    }

    return $archives
}

proc pull_website {} {
    global theproject theuser thepassword thedestination

    # And a third way of doing authentication, now using SSH. We use a
    # temp config file to force ssh to use password authentication,
    # and then use Expect to intercept the pty and supply the password
    # when ssh asks for it..

    log Retrieving website...

    set config [dest SSH] ;#[fileutil::tempfile]
    fileutil::writeFile $config \
	PreferredAuthentications=password\n

    # Note that the trailing /'es added in the rsync invokation are
    # required. They ensure that the website destination directory is
    # htdocs, instead of containing a sub-directory named htdocs.
    set src ${theuser},${theproject}@web.sourceforge.net:htdocs
    set dst Website

    file mkdir $thedestination

    # No logging of the interaction.
    # Spawn rsync over ssh.
    # Wait for the password query, then supply the password, at last
    # let rsync run. We suppress the output, but drive a barber
    # pole for each line we get.

    set cmd [list exp_spawn rsync -avP -e [list ssh -F $config] $src/ [dest $dst/]]

    # An issue here may be caused by outdated SSH keys, 
    #log $cmd

    exp_log_user 0
    eval $cmd
    expect {
	"password: " {}
	"REMOTE HOST IDENTIFICATION HAS CHANGED" {
	    log {Please fix your known_hosts file}
	    log {Remove the entry for web.sourceforge.net}
	    exit
	}
	"Are you sure you want to continue connecting" {
	    log {We are sure...}
	    exp_send yes\r
	}
    }
    log {Sending password...}
    exp_send  $thepassword\r
    log_barber_pole_start
    expect {
	"*\r" {
	    log_barber_pole
	    exp_continue
	}
	eof {}
    }
    log_barber_pole_done

    # Get rid of the temp configuration.
    file delete $config
    return $dst
}

proc pull_repository {} {
    global therepotype theproject thedestination

    log Retrieving project $therepotype repository...

    # Note: This is the only part of the project where no
    # authentication is required. I.e. this is something anybody can
    # do, for any project.

    if {$therepotype eq "svn"} {
	set root $therepotype
    } else {
	# cvs, hg, git, bzr
	set root ${therepotype}root
    }

    set src ${theproject}.${therepotype}.sourceforge.net::$root/$theproject/*
    set dst Repository

    file mkdir $thedestination

    log_barber_pole_start
    exp_log_user 0
    exp_spawn rsync -avP $src $thedestination/$dst
    expect {
	"*\r" {
	    log_barber_pole
	    exp_continue
	}
	eof {}
    }
    log_barber_pole_done
    return $dst
}

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

proc verify_project {} {
    global theproject thepid therepotype

    set url http://sourceforge.net/projects/$theproject/

    puts "Get project id of $url..."

    set token [http::geturl $url]
    set data  [http::data $token]
    http::cleanup $token

    if {[regexp {Invalid Project} $data]} {
	log "Project $theproject = INVALID"
	log "I.e. sourceForge claims that it doesn't know this name."
	log "Please check your spelling."
	exit
    }

    #puts <$data>

    set pattern "group_id=(\[0-9\]+)"
    if {![regexp $pattern $data -> thepid]} {
	log "Project $theproject : Unable to determine pid"
	puts $data
	return -code error FAIL/id
    }

    puts "Get repository type of project $thepid..."

    # Supported repository types: cvs, svn, hg, git, bzr.

    # In the main page the repository type is hidden somewhere within
    # a javascript which is loaded later. The public_info page however
    # still seems to provide us with this information directly in the
    # HTML. It is however a page requiring login.

    set tmp [pull-with-cookie-login \
		 https://sourceforge.net/project/admin/public_info.php?group_id=$thepid \
		 public_info.html]

    set data [fileutil::cat $tmp]

    set pattern "scm/\\?type=(\[^&\]+)"
    if {![regexp $pattern $data -> therepotype]} {
	log "Project $theproject : Unable to determine repository type"
	return -code error FAIL/type
    }

    log "Project $theproject = $thepid ($therepotype)"
    return
}

proc pull-with-cookie-login {url file} {
    global thedestination

    variable thecookies

    set dst  $thedestination/$file
    set tmp  [fileutil::tempfile]

    # The login credentials are transmitted indirectly, through us
    # having the cookie returned by the login form we submitted (see
    # the procedure mauve::login where this is done).

    # Using protocol 1.0 disables chunked transfer, something SF will
    # do for 1.1, and which http doesn't handle properly for -channel.

    log_progress_start

    set chan  [open $tmp w]
    set token [http::geturl $url \
		   -protocol 1.0 \
		   -channel $chan \
		   -headers [login_cookies] \
		   -progress log_progress]
    log_progress_done [file size $tmp]

    http::wait    $token
    http::cleanup $token
    close $chan

    file mkdir [file dirname $dst]
    #file copy -force $tmp $dst
    file rename -force $tmp $dst

    return $dst
}

proc pull-with-basic-login {url file} {
    global thedestination theuser thepassword

    set dst $thedestination/$file
    set tmp [fileutil::tempfile]

    # Here the login credentials are transmitted through 'Basic' http
    # authentication.

    # Using protocol 1.0 disables chunked transfer, something SF will
    # do for 1.1, and which http doesn't handle properly for -channel.

    log_progress_start

    set chan [open $tmp w]
    fconfigure $chan -encoding binary -translation binary

    # The transfer is configured binary to avoid problems if a mail
    # contains a bogus encoding (spam), tripping the core (invalid
    # argument during a write, improper character, 7MB into a 48 MB
    # file. tcl-core mail archive triggered this).

    #log Using $theuser:$thepassword
    #log Using [list Authorization [concat "Basic" [base64::encode $theuser:$thepassword]]]

    set token [http::geturl $url \
		   -binary 1 \
		   -protocol 1.0 \
		   -channel $chan \
		   -headers [list Authorization \
				 [concat "Basic" \
				      [base64::encode $theuser:$thepassword]]] \
		   -progress log_progress]
    log_progress_done [file size $tmp]

    http::wait    $token
    http::cleanup $token
    close $chan

    file mkdir [file dirname $dst]
    file rename -force $tmp $dst
    return
}

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

proc login_cookies {} {
    global thecookies
    if {[info exists thecookies] && [llength $thecookies]} {
	puts {Cached cookies...}
	return $thecookies
    }

    global theproject theuser thepassword

    # Run the sourceforge authentication form.
    set url https://sourceforge.net/account/login.php

    # form_loginname = user
    # form_pw        = password
    # login          = The submit button.

    set query [http::formatQuery \
			       form_loginname $theuser \
			       form_pw        $thepassword \
			       login          {Log in}]

    #puts Q($query)

    set token [http::geturl $url \
		   -query $query]
    #set meta [http::meta $token]

    #puts RESPONSE_____________________________________________
    #parray $token
    #puts _____________________________________________________

    set meta [set ${token}(meta)]
    http::cleanup $token

    set lines {}
    foreach {k v} $meta {
	if {$k ne "Set-Cookie"} continue
	set cookie [lindex [split $v {;}] 0]
	# Cookie is in the form of 'k=v'.
	# We can use this form directly.
	lappend lines $cookie
    }
    set thecookies [list Cookie: [join $lines {;}]]

    log Logged in as $theuser
    #log $thecookies
    return $thecookies
}

# ### ### ### ######### ######### #########
## Helper. Interface to log output and progress bars.

proc log {args} {
    puts [join $args]
    return
}

proc log_barber_pole_start {} {
    global thepole
    set    thepole {*   *   *   }
    return
}

proc log_barber_pole {} {
    global thepole
    puts -nonewline \r$thepole
    flush stdout
    set thepole [string range $thepole 1 end][string index $thepole 0]
    return
}

proc log_barber_pole_done {} {
    puts "\rOK                                           "
    return
}

proc log_progress_start {} {}

proc log_progress {token total current} {
    if {$total == 0} { set total ??? }

    puts -nonewline \r$current/$total
    flush stdout
    return
}

proc log_progress_done {msg} {
    puts "\rOK $msg                                     "
    return
}

proc dest {path} {
    global thedestination
    file mkdir $thedestination
    return [file join $thedestination $path]
}

# ### ### ### ######### ######### #########
## Helper code to generate JSON structures.
## Snarfed from Tcllib, the json export plugins for
## doctools2{idx,toc},
##
## Expects an array variable 'config' in the caller, containing the
## keys 'aligned' and 'indented' (Bboth mapping to a boolean value).

proc JsonQuotes {} {
    return [list "\"" "\\\"" / \\/ \\ \\\\ \b \\b \f \\f \n \\n \r \\r \t \\t]
}

proc JsonString {s} {
    return "\"[string map [JsonQuotes] $s]\""
}

proc JsonArray {args} {
    upvar 1 config config
    return [JsonArrayList $args]
}

proc JsonArrayList {list} {
    # compact form.
    return "\[[join $list ,]\]"
}

proc JsonObject {args} {
    upvar 1 config config
    return [JsonObjectDict $args]
}

proc JsonObjectDict {dict} {
    # The dict maps string keys to json-formatted data. I.e. we have
    # to quote the keys, but not the values, as the latter are already
    # in the proper format.
    upvar 1 config config

    set tmp {}
    foreach {k v} $dict { lappend tmp [JsonString $k] $v }
    set dict $tmp

    if {$config(aligned)} { Align $dict max }

    if {$config(indented)} {
	set content {}
	foreach {k v} $dict {
	    if {$config(aligned)} { set k [FmtR max $k] }
	    if {[string match *\n* $v]} {
		# multi-line value
		lappend content "    $k : [textutil::adjust::indent $v {    } 1]"
	    } else {
		# single line value.
		lappend content "    $k : $v"
	    }
	}
	if {[llength $content]} {
	    return "\{\n[join $content ,\n]\n\}"
	} else {
	    return "\{\}"
	}
    } else {
	# ultra compact form.
	set tmp {}
	foreach {k v} $dict { lappend tmp "$k:$v" }
	return "\{[join $tmp ,]\}"
    }
}

proc Align {dict mv} {
    upvar 1 $mv max
    # Generate a list of references sortable by name, and also find the
    # max length of all relevant names.
    set max 0
    foreach {str _} $dict { Max max $str }
    return
}

proc Max {v str} {
    upvar 1 $v max
    set x [string length $str]
    if {$x <= $max} return
    set max $x
    return
}

proc FmtR {v str} {
    upvar 1 $v max
    return $str[string repeat { } [expr {$max - [string length $str]}]]
}

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

main
exit

Added etc/backup_fossilized.















>
>
>
>
>
>
>
1
2
3
4
5
6
7
# -*- tcl -*- Fossil repositories to backup for ActiveState's use.
pull fossil       http://www.fossil-scm.org
pull sqlite       http://sqlite.org/src
pull tdbc         http://kbk.is-a-geek.net:2301/index
pull tdbc         http://tdbc.tcl.tk/index.cgi/index
pull crimp	  http://chiselapp.com/user/andreas_kupries/repository/crimp
pull critcl       http://chiselapp.com/user/andreas_kupries/repository/CriTcl

Added etc/backup_git.































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# -*- tcl -*- Git repositories to backup for ActiveState's use.
pull tdom         https://github.com/tDOM/tdom.git
pull jimtcl       http://repo.or.cz/w/jimtcl.git
pull tcl.gd       https://github.com/lehenbauer/tcl.gd.git
pull tclspline    https://github.com/lehenbauer/tclspline.git
pull speedtables  https://github.com/lehenbauer/speedtables.git
pull speedbag     https://github.com/lehenbauer/speedbag.git
pull tclbsd       https://github.com/lehenbauer/tclbsd.git
pull diffutiltcl  https://github.com/pspjuth/DiffUtilTcl.git
pull tmag         https://github.com/makr/tmag.git
pull TclTweezer   https://github.com/flightaware/TclTweezer.git
pull as-tcl-core  https://github.com/ActiveState/tcl-core.git
pull das-tcl-core https://github.com/das/tcl.git
pull partcl       https://github.com/partcl/partcl.git
pull llvmtcl      https://github.com/jdc8/llvmtcl.git

Added etc/backup_sourceforge.



























































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
# -*- tcl -*- Sourceforge repositories to backup for ActiveState's use.
pull abuse
pull acdk
pull aclip
pull acs-misc
pull aejaks
pull agemail
pull agqt
pull akinimod
pull alicq
pull alphatcl
pull altogether
pull amsn
pull aolserver
pull avicaptcl
pull ayam
pull bastard
pull beepcore-tcl
pull blt
pull ctags
pull drone
pull e4graph
pull eddie42
pull EMC
pull emu
pull espeakf
pull etktab
pull expect
pull fishell
pull freewrap
pull ghostscript
pull glimmer
pull gpib-tcl
pull gpsbabel
pull gracer
pull hamlib
pull herqules
pull htmlalbum
pull incrtcl
pull installbase
pull iocpsock
pull irk
pull it-mame
pull jerukey
pull kalich
pull kt2c
pull libtclpq
pull linudent
pull mdtoceditor
pull memchan
pull metakit
pull mimersbrunn
pull minitik
pull mkextensions
pull mmucl
pull modules
pull moodss
pull mpexpr
pull msworkbench
pull nac
pull naviserver
pull net-snmp
pull now-well
pull nsclspectcl
pull nsjava
pull nstcl
pull nws
pull odie
pull om2t
pull opencvlibrary
pull openfts
pull oratcl
pull palmtcl
pull palm-tcl
pull pgdiff
pull pgmail
pull photopc
pull pleac
pull plplot
pull pockettcl
pull poet
pull polyglotman
pull PSIC
pull ptcon
pull quarterstaff
pull quirc
pull rbctoolkit svn
pull reaperscripts
pull robotournament
pull rtwo
pull savi
pull savirc
pull scriptittcl
pull simpledevlib
pull smc
pull snackamp
pull sockspy
pull sourcenav
pull spectcl
pull spgmr08
pull swig
pull sybtcl
pull syncal
pull tami
pull tcl
pull tcladdressbook
pull tclads
pull tclae
pull tclagent
pull tclapplescript
pull tclbeauty
pull tclbitprint
pull tclcanvas
pull tcl-c-builder
pull tclcde
pull tclce
pull tclcompiler
pull tclcompress
pull tclcryptography
pull tcl-dac
pull tcldbi
pull tcl-dbi
pull tcldes
pull tcldoc
pull tcldp
pull tcldrop
pull tcl-edit
pull tcleftools
pull tclengines
pull tclev
pull tclex
pull tcl-fastcgi
pull tclfr
pull tclgbp
pull tcl-gdbi
pull tclgendoc
pull tcl-golems
pull tcl-gtk
pull tclhtml
pull tclhttp1-1
pull tclhttpd
pull tclicu
pull tcl-idaemons
pull tclines
pull tclinux
pull tclipdnsmgt
pull tclish
pull tcljava
pull tclkeymon
pull tclldap
pull tcllib
pull tclmagick
pull tcl-mccp
pull tclmml
pull tcl-nap
pull tclnoc
pull tclodbc
pull tclpad
pull tclpcap
pull tcl-pkg
pull tclplugin
pull tclpos
pull tclpro
pull tcl-qt
pull tclral
pull tclrar
pull tclreadline
pull tclresource
pull tclrfb
pull tclscript
pull tcl-scripts
pull tclserv
pull tclsharing
pull tclshout
pull tclsoap
pull tclspeech
pull tclspice
pull tclsql
pull tcl-sql
pull tclstubs
pull tclsvn
pull tcltax
pull tcltexed
pull tcltextedit
pull tcltk
pull tcltkaqua
pull tcltkce
pull tcltkmanpl
pull tcltkskin
pull tcltktools
pull tcl-tlc
pull tcltrf
pull tclubbuilder
pull tcludp
pull tclunit
pull tclvfs
pull tclvs
pull tclweb
pull tclwebtest
pull tclx
pull tclxml
pull tclxpcom
pull tease
pull tel
pull tickletux
pull tidy
pull tik
pull tikpkgs
pull tinytcl
pull tivo
pull tix
pull tixlibrary
pull tixTixapps
pull tkcon
pull tkcvs
pull tkdiff
pull tkdnd
pull tkdvi
pull tkfestival
pull tkfp
pull tkhextego
pull tkimg
pull tkimg svn
pull tkman
pull tkoutline
pull tkpoker
pull tkproe
pull tksec
pull tktable
pull tktoolkit
pull tktreectrl
pull tls
pull tmml
pull togl
pull Togl
pull toucan
pull trebuchet
pull tsippwb
pull turkdrop
pull twapi
pull txt2regex
pull tygemo
pull units
pull vis5d
pull voodoo
pull vtcl
pull vtclcheck
pull waxml
pull webcpp
pull webware
pull wisewig
pull wishgl2
pull zbcw

Added etc/backup_svn.



























>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
pull tclws    http://tclws.googlecode.com/svn
pull wub      http://wub.googlecode.com/svn
pull wubwikit http://wubwikit.googlecode.com/svn
pull wikitcl  http://wikitcl.googlecode.com/svn
pull wubchain http://wubchain.googlecode.com/svn
pull tcc      http://tcltcc.googlecode.com/svn
pull tclkit   http://tclkit.googlecode.com/svn
pull tclxmpp  http://tclxmpp.googlecode.com/svn
pull tclgpg   http://tclgpg.googlecode.com/svn
pull deskml   http://deskml.googlecode.com/svn
pull ureversi http://ureversi.googlecode.com/svn
pull tcljs    http://tcljs.googlecode.com/svn
pull critcl   svn://svn.equi4.com/

Added etc/pullsf.













































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
expect
incrtcl
memchan
oratcl
rbctoolkit
tcl
tclapplescript
tclbitprint
tcllib
tclplugin
tclpro
tclsoap
tcltrf
tclvfs
tclweb
tclx
tclxml
tkimg
tktable
tktoolkit
tktreectrl
twapi