# Utility code shared between several scripts
# 03-10-2003 jcw
  lappend auto_path lib
  package require ascenc
  package require md5c
# convert md5 + size into a path for that file
  proc amspath {md5 size {create 0}} {
      # 128b MD5 + 27b size -> 31 encoded chars (base-32)
    append x $md5 [binary format I [expr {$size<<5}]]
    set encoded [string range [ascenc::b2a_32 $x] 0 end-1]
      # first two chars are used to create up to 1024 subdirs
    set dn [file join data [string range $encoded 0 1]]
    if {$create && ![file isdir $dn]} {
      file mkdir $dn
    }
    file join $dn $encoded
  }
# traverse directory tree, used by version_id proc
  proc traverse {args} {
    set sig 0
    set mod 0
    while {[llength $args] > 0} {
      set d [lindex $args 0]
      set args [lrange $args 1 end]
      foreach path [lsort [glob -nocomplain [file join $d *]]] {
	set t [file tail $path]
	switch -- $t CVS - RCS - core - a.out continue
	lappend sig $t
	if {[file isdir $path]} {
	  lappend args $path
	} else {
	  set m [file mtime $path]
	  if {$m > $mod} { set mod $m }
	  lappend sig $m [file size $path]
	}
      }
    }
    list [vfs::crc [join $sig " "]] $mod
  }
# calculate the version id of all files in given dir (may be mounted)
  proc version_id {dir {name ""}} {
    lassign [traverse $dir] sig mod
    set time [clock format $mod -format {%Y/%m/%d %H:%M:%S} -gmt 1]
    puts [format {%s  %d-%d  %s} $time [expr {(($sig>>16) & 0xFFFF) + 10000}] \
					[expr {($sig & 0xFFFF) + 10000}] $name]
  }
# determine size of header prefix of a metakit datafile
  proc mkheader {filename} {
    if {![file exists $filename]} {
      error "file does not exist"
    }
    if {![file isfile $filename]} {
      error "not a regular file (perhaps mounted as VFS?)"
    }
    set end [file size $filename]
    if {$end < 27} {
      error "file too small, cannot be a datafile"
    }
    set fd [open $filename]
    fconfigure $fd -translation binary
    seek $fd -16 end
    binary scan [read $fd 16] IIII a b c d
    if {($c >> 24) != -128} {
      error "not a Metakit datafile"
    }
    # avoid negative sign / overflow issues
    if {[format %x $a] eq "80000000"} {
      set start [expr {$end - 16 - $b}]
    } else {
      # if the file is in commit-progress state, we need to do more
      error "this code needs to be finished..."
    }
    seek $fd $start
    switch -- [read $fd 2] {
      JL { set endian little }
      LJ { set endian big }
      default { error "failed to locate file header" }
    }
    close $fd
    return $start
  }
# convert an open MK datafile to a serialized string representation
  proc mk2str {db} {
    set fd [vfs::memchan]
    mk::file save $db $fd
    seek $fd 0
    set r [read $fd]
    close $fd
    return $r
  }
# load a string into an open db, replacing its contents
  proc str2mk {data db} {
    if {[string length $data] > 0} {
      set fd [vfs::memchan]
      fconfigure $fd -translation binary
      puts -nonewline $fd $data
      flush $fd
      seek $fd 0
      mk::file load $db $fd
      close $fd
    } else {
      # loading empty string clears the db
      foreach x [mk::file views $db] {
        mk::view layout $db.$x {}
      }
    }
  }
# open an in-memory MK storage, contents given as string, returns db name
  proc memstorage {{data ""}} {
    global memdb_seqn
    if {![info exists memdb_seqn]} { set memdb_seqn 0 }
    set db memdb[incr memdb_seqn]
    mk::file open $db
    if {[string length $data] > 0} {
      str2mk $data $db
    }
    return $db
  }
# open an in-memory MK VFS, contents given as string, returns db name
  proc memvfs {path data} {
    set db [memstorage $data]
    # mount from a MK datafile, bypass usual logic
    vfs::filesystem mount $path [list vfs::mk4::handler $db]
    vfs::RegisterMount $path [list ::vfs::mk4::Unmount $db]
    return $db
  }
# extract auxiliary info added by kit2cat
  proc catinfo {db} {
    set r {}
    mk::loop c $db.sync { lappend r [mk::get $c s] }
    return $r
  }
# remote procedure call, wraps a request/response as HTTP
  proc rpc {url data} {
    #puts "sent [string length $data] bytes"
    package require http
    set t [http::geturl $url -query $data -binary 1 \
			-type "application/octet-stream"]
    if {[http::status $t] ne "ok" || [http::ncode $t] != 200} {
      set r "unexpected reply: [http::code $t]"
      http::cleanup $t
      error $r
    }
    set r [http::data $t]
    http::cleanup $t
    #puts "got: [string length $r] bytes"
    return $r
  }
# read one datafile from starchive storage, given a 31-char digest name
  proc readone {x} {
    set fn data/[string range $x 0 1]/$x
    set fd [open $fn]
    fconfigure $fd -translation binary
    set data [read $fd]
    close $fd
    return $data
  }
# extract auxiliary info added by kit2cat, etc
  proc catinfos {view} {
    set r {}
    mk::loop c $view { lappend r [mk::get $c s] }
    return $r
  }
# call request handler with input data as arg, send result back to rpc client
  proc reqreply {handler} {
    fconfigure stdin -translation binary
    set in [read stdin]
    lassign [$handler $in] info out
    puts "Content-type: application/octet-stream"
    puts "Content-length: [string length $out]\n"
    fconfigure stdout -translation binary
    puts -nonewline $out
    flush stdout
    list [string length $in] [string length $out] $info
  }
# the main starsync trick: strip contents of all files
  proc stripdata {db} {
    mk::view layout $db.dirs {name parent:I {files {name size:I date:I}}}
  }
# try to compress, else return as is
  proc tryzip {s} {
    set z [vfs::zip -mode compress $s]
    if {[string length $z] < [string length $s]} {
      set s $z
    }
    return $s
  }