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