1# Synchronization of starkits across a communications channel
2# Dec 2001, Jean-Claude Wippler <jcw@equi4.com>
3
4package provide starsync 1.0
5
6namespace eval starsync {
7  namespace export request summary reply
8
9# private state
10  namespace eval v {
11    variable seqn	0	;# used to generate db names
12    variable vers	1	;# protocol format
13  }
14
15# update local starkit, using differences obtained from server
16  proc request {url path {fake 0}} {
17    set id [string tolower [file root [file tail $path]]]
18    # if file is new and we're doing a real sync, fetch full copy
19    if {![file exists $path] && !$fake} {
20      set data [rpc $url [vfs::zip -mode c [kit2cat $path <F/$v::vers> $id]]]
21      if {$data eq ""} return
22      # create file from scratch
23      set fd [open $path w]
24      fconfigure $fd -translation binary
25      puts -nonewline $fd $data
26      close $fd
27      # return full catalog made from local copy
28      return [kit2cat $path]
29    }
30    set data \
31      [rpc $url [vfs::zip -mode c [kit2cat $path <D/$v::vers> $id $fake]]]
32    if {$data eq "" || $fake} { return $data }
33    # apply the differences to local starkit
34    vfs::mk4::Mount $path $path -nocommit
35    set r [applydiffs $data $path]
36    vfs::unmount $path
37    return $r
38  }
39
40# apply differences to starkit, return stripped catalog
41  proc applydiffs {data path} {
42    set db [memvfs <diff> $data]
43    for {lappend dirs {}} {[llength $dirs]} {set dirs [lrange $dirs 1 end]} {
44      set curr [lindex $dirs 0]
45      foreach x [glob -nocomplain -tails -directory <diff> -join $curr *] {
46	set t [file join <diff> $x]
47	set h [file join $path $x]
48	if {[file isdir $t]} {
49	  file mkdir $h
50	  lappend dirs $x
51	} else {
52	  file delete -force $h
53	  set m [file mtime $t]
54	  if {$m} {
55	    file copy $t $h
56	    file mtime $h $m
57	  }
58	}
59      }
60    }
61    stripdata $db
62    set r [mk2str $db]
63    vfs::unmount <diff>
64    return $r
65  }
66
67# generate a list of file and size entries from a catalog string
68  proc summary {data} {
69    set xfers {}
70    if {$data ne ""} {
71      memvfs <diff> $data
72      for {lappend dirs {}} {[llength $dirs]} {set dirs [lrange $dirs 1 end]} {
73	set curr [lindex $dirs 0]
74	foreach x [glob -nocomplain -tails -directory <diff> -join $curr *] {
75	  set t [file join <diff> $x]
76	  if {[file isdir $t]} {
77	    lappend dirs $x
78	  } elseif {[file mtime $t]} {
79	    lappend xfers $x [file size $t]
80	  } else {
81	    lappend xfers $x -
82	  }
83	}
84      }
85      vfs::unmount <diff>
86    }
87    return $xfers
88  }
89
90# remote procedure call, wraps a request/response as HTTP
91  proc rpc {url data} {
92    #puts "sent [string length $data] bytes"
93    package require http
94    set t [http::geturl $url -query $data -binary 1 \
95			-type "application/octet-stream"]
96    if {[http::status $t] ne "ok" || [http::ncode $t] != 200} {
97      set r "unexpected reply: [http::code $t]"
98      http::cleanup $t
99      error $r
100    }
101    set r [http::data $t]
102    http::cleanup $t
103    #puts "got: [string length $r] bytes"
104    return $r
105  }
106
107# the main starsync trick: strip contents of all files
108  proc stripdata {db} {
109    mk::view layout $db.dirs {name parent:I {files {name size:I date:I}}}
110  }
111
112# take starkit as input, produce MK catalog as result (args are passed along)
113  proc kit2cat {path args} {
114    set db db[incr v::seqn]
115    if {[file exists $path]} {
116      mk::file open $db $path -readonly
117    } else {
118      mk::file open $db
119    }
120    stripdata $db
121    mk::view layout $db.sync s
122    foreach x $args { mk::row append $db.sync s $x }
123    set r [mk2str $db]
124    mk::file close $db
125    return $r
126  }
127
128# convert an open MK datafile to a serialized string representation
129  proc mk2str {db} {
130    set fd [vfs::memchan]
131    mk::file save $db $fd
132    seek $fd 0
133    set r [read $fd]
134    close $fd
135    return $r
136  }
137
138# open an in-memory MK VFS, contents given as string, returns db name
139  proc memvfs {path data} {
140    # set up in-mem channel with result
141    set fd [vfs::memchan]
142    fconfigure $fd -translation binary
143    puts -nonewline $fd $data
144    flush $fd
145    seek $fd 0
146    # open result as MK datafile
147    set db db[incr v::seqn]
148    mk::file open $db
149    mk::file load $db $fd
150    close $fd
151    # mount from a MK datafile, bypass usual logic
152    vfs::filesystem mount $path [list vfs::mk4::handler $db]
153    vfs::RegisterMount $path [list ::vfs::mk4::Unmount $db]
154    return $db
155  }
156
157# extract auxiliary info added by kit2cat
158  proc catinfo {db} {
159    set r {}
160    mk::loop c $db.sync { lappend r [mk::get $c s] }
161    return $r
162  }
163
164# difference logic, leaves $here with only diffs from $there
165  proc calcdiff {here there} {
166    set hasmods 0
167    set delpend {}
168    foreach x [glob -nocomplain -tails -directory $there *] {
169      set remote($x) ""
170    }
171    foreach x [glob -nocomplain -tails -directory $here *] {
172      if {[info exists remote($x)]} {
173	set h [file join $here $x]
174	set t [file join $there $x]
175	if {[file isfile $h] && [file isfile $t] &&
176		  [file size $h] == [file size $t] &&
177		  [file mtime $h] == [file mtime $t]} {
178	  lappend delpend $h
179        } elseif {[file isdir $h] && [file isdir $t]} {
180	  if {[calcdiff $h $t]} {
181	    incr hasmods
182	  } else {
183	    lappend delpend $h
184	  }
185	} else {
186	  incr hasmods
187	}
188	array unset remote $x
189      } else {
190        incr hasmods
191      }
192    }
193    foreach x [array names remote] {
194      set h [file join $here $x]
195      close [open $h w]
196      file mtime $h 0 ;# this flags entry as being a deletion
197      incr hasmods
198    }
199    if {$hasmods} {
200      foreach x $delpend { file delete -force $x }
201    }
202    return $hasmods
203  }
204
205# take incoming catalog and return difference starkit
206  proc <D/1> {tid path fake} {
207    set r ""
208    if {[file exists $path]} {
209      #2003-02-01 expand symlinks because mk4vfs has trouble with it
210      catch { set path [file readlink $path] }
211      set db [vfs::mk4::Mount $path $path -readonly]
212      catch { vfs::attributes $path -state translucent }
213      if {[calcdiff $path $tid]} {
214	if {$fake} { stripdata $db }
215	set r [mk2str $db]
216      }
217      vfs::unmount $path
218    }
219    return $r
220  }
221
222# return full starkit for initial download (including header)
223  proc <F/1> {tid path} {
224    set fd [open $path]
225    fconfigure $fd -translation binary
226    set r [read $fd]
227    close $fd
228    return $r
229  }
230
231# request handler, takes a request and dispatches as needed
232  proc reqhandler {data} {
233    if {[string length $data] == 0} { return - }
234    set info [catinfo [set db [memvfs <temp> [vfs::zip -mode d $data]]]]
235    lassign $info cmd id
236    if {[string match <?/?> $cmd] && [string is wordchar -strict $id]} {
237      set out [eval [lreplace $info 1 1 <temp> $id.kit]]
238    } else {
239      set out ?
240    }
241    vfs::unmount <temp>
242    list $info $out
243  }
244
245# call request handler with input data as arg, send result back to rpc client
246  proc reply {} {
247    fconfigure stdin -translation binary
248    set in [read stdin]
249    lassign [reqhandler $in] info out
250    puts "Content-type: application/octet-stream"
251    puts "Content-length: [string length $out]\n"
252    fconfigure stdout -translation binary
253    puts -nonewline $out
254    flush stdout
255    list [string length $in] [string length $out] $info
256  }
257}
258