#! /usr/bin/env tclkit
# Add a starkit to a remote starchive
# 03-10-2003 jcw
array set config {
  site https://www.equi4.com/starch/shandler.cgi
  kits https://www.equi4.com/starch/kits
  user jcw
  pass haha
}
source [file join [file dirname [info script]] util.tcl]
# generate a list of MD5's plus sizes over all files in a starkit
# side effect is to fill in the md5 property of all file rows
  proc collectmd5 {db} {
    set r {}
    mk::loop d $db.dirs {
      mk::loop f $d.files {
	array set fr [mk::get $f]
	set data $fr(contents)
	if {[string length $data] != $fr(size)} {
	  set data [vfs::zip -mode decompress $data]
	}
	set md [md5c $data]
	mk::set $f md5:B $md
	#TODO weed out duplicates
	lappend r $md $fr(size)
      }
    }
    return $r
  }
# create a temp storage with pairwise args defining the views in it
  proc defout {args} {
    set db [memstorage]
    foreach {x y} $args {
      mk::view layout $db.$x $y
    }
    return $db
  }
# check whether an URL can be accessed
  proc urlexists {url} {
    package require http
    set t [http::geturl $url]
    set n [http::ncode $t]
    http::cleanup $t
    return $n
  }
# copy new files, so they will be sent
# also returns date of newest file seen
  proc copynew {dbr dbk} {
    set last 0
    mk::view layout $dbr.d {m:B l:I c:B t:I}
    # collect list of missing files
    mk::loop c $dbr.d {
      set key [mk::get $c m],[mk::get $c l]
      set a($key) $c
    }
    # go through all files, copy contents when needed
    mk::loop d $dbk.dirs {
      mk::loop f $d.files {
	array set fr [mk::get $f]
        set key $fr(md5),$fr(size)
	if {[info exists a($key)]} {
	  #puts [format {%10d  %s} $fr(size) $fr(name)]
	  mk::set $a($key) c $fr(contents) t $fr(date)
	  unset a($key)
	}
	if {$fr(date) > $last} {
	  set last $fr(date)
	}
      }
    }
    return $last
  }
# call out to server, pass db in, get db back
  proc doreq {db url args} {
    #puts db-$db-$args
    mk::view layout $db.r s
    mk::view size $db.r 0
    foreach x $args {
      mk::row append $db.r s $x
    }
    set req [mk2str $db]
    #puts req-[string length $req]
    set res [rpc $url $req]
    #puts res-[string length $res]
    if 1 {
      set fd [open result.html w]
      fconfigure $fd -translation binary
      puts -nonewline $fd $res
      close $fd
    }
    str2mk $res $db
    return [string length $req]
  }
proc addsk {name msg} {
  global config
  # make sure the input file is a valid starkit
  #puts $name:
  set tail [file root [file tail $name]]
  if {![file readable $name]} {
    puts "$name: not readable, skipped"
    return
  }
  if {[file isdir $name]} {
    puts "$name: directory, skipped"
    return
  }
  set e [catch { mkheader $name } start]
  if {$e} {
    puts "$name: not a starkit, skipped"
    return
  }
  set db [vfs::mk4::Mount $name <kit> -readonly]
  # check that this version does not yet exist
  set sig [lindex [traverse <kit>] 0]
  set vid [format {%d-%d} [expr {(($sig>>16) & 0xFFFF) + 10000}] \
			  [expr {($sig & 0xFFFF) + 10000}]]
  if {[urlexists $config(kits)/$tail-$vid] == 200} {
    vfs::unmount <kit>
    puts "$name: version $vid already in archive, skipped"
    return
  }
  # set up a request "db"
  set dbr [defout d {m:B l:I}]
  puts -nonewline "\r  calculating checksums... "
  flush stdout
  foreach {x y} [collectmd5 $db] {
    mk::row append $dbr.d m $x l $y
  }
  # compare md5's of all files with remote starchive contents
  set nc [mk::view size $dbr.d]
  puts -nonewline "\r  comparing $nc entries... "
  flush stdout
  set n1 [doreq $dbr $config(site) <C/2> $config(user) $config(pass) $tail]
  # prepare the data to be submitted
  set ns [mk::view size $dbr.d]
  puts -nonewline "\r  sending $ns of $nc files... "
  flush stdout
  set last [copynew $dbr $db]
  stripdata $db
  set cdat [mk2str $db]
  set clen [string length $cdat]
  set cmd5 [md5c $cdat]
  # add one more entry for the compressed catalog itself
  mk::row append $dbr.d m $cmd5 l $clen c [tryzip $cdat] t $last
  # now sumbit all the requested missing files and the catalog
  set n2 [doreq $dbr $config(site) <S/2> $config(user) $config(pass) $tail $msg]
  set kb [expr {($n1+$n2+1023)/1024}]
  set vid [mk::get $dbr.r!1 s]
  set url [mk::get $dbr.r!3 s]
  puts "\r  submitted as $tail-$vid ($ns/$nc files, $kb Kb sent)"
  flush stdout
  mk::file close $dbr
  vfs::unmount <kit>
}
if {[llength $argv] < 1} {
  puts "Usage: staradd starkit ?'comment'?"
  exit
}
foreach {kit msg} $argv break
if {[catch { addsk $kit $msg } err]} {
  puts $errorInfo
}