#!/bin/env tclsh

package require sha256
package require sqlite3

proc readbak {path} {
  set fd [open $path rb]
  set magic [read $fd 6]
  if {$magic != "AMEBAK"} {
    close $fd
    return -code error "invalid magic string: \"$magic\""
  }

  set ver [read $fd 1]
  binary scan $ver c ver
  if {$ver != 0} {
    close $fd
    return -code error "archive file too new: $ver (self: 0)"
  }

  set mode [read $fd 1]
  read $fd 8; # skip filesize
  switch -- $mode {
    r {}
    F {
      zlib push inflate $fd -level 9
    }
    default {
      close $fd
      return -code error "unknown compression mode: $mode"
    }
  }

  set ret [read $fd]
  close $fd
  return $ret
}
proc readstore {store hash {hex 0}} {
  if {!$hex} { set hexhash [binary encode hex $hash] }
  set path $store
  append path "/[string range $hexhash 0 1]"
  append path "/[string range $hexhash 2 3]"
  append path "/[string range $hexhash 4 5]/"
  append path "/[string range $hexhash 6 end]"
  if {[file exists $path]} {
    return [readbak $path]
  } else {
    return -code error "missing file"
  }
}

proc writebak {path data} {
  binary scan $data c _
  set bench [string range $data 0 10000000]
  binary scan $bench c _
  set Fbench [zlib deflate $bench 9]

  set fd [open $path wb]
  puts -nonewline $fd "AMEBAK\0"

  set compress 0
  if {[string length $Fbench] < ([string length $bench] * 95 / 100)} {
    puts -nonewline $fd "F"
    set compress 1
  } else { puts -nonewline $fd "r" }

  puts -nonewline $fd [binary format W [string length $data]]

  if {$compress} { zlib push deflate $fd -level 9 }

  puts -nonewline $fd $data
  close $fd
}
proc writestore {store data {hex 0}} {
  set hash [::sha2::sha256 -bin -- $data]
  set hexhash [binary encode hex $hash]
  set path $store
  append path "/[string range $hexhash 0 1]"
  append path "/[string range $hexhash 2 3]"
  append path "/[string range $hexhash 4 5]/"
  file mkdir $path
  set path "$path/[string range $hexhash 6 end]"

  if {![file exists $path]} {
    writebak $path $data
  }

  if {$hex} {
    return $hexhash
  } else {
    return $hash
  }
}

proc statbak {path} {
  set fd [open $path rb]
  set magic [read $fd 6]
  if {$magic != "AMEBAK"} {
    close $fd
    return -code error "invalid magic string: \"$magic\""
  }

  set ver [read $fd 1]
  binary scan $ver c ver
  if {$ver != 0} {
    close $fd
    return -code error "archive file too new: $ver (self: 0)"
  }

  set mode [read $fd 1]
  switch -- $mode {
    r { set mode raw }
    F { set mode deflate }
    default {
      close $fd
      return -code error "unknown compression mode: $mode"
    }
  }

  set disksize [file size $path]
  binary scan [read $fd 8] W datasize

  close $fd
  return [list ver $ver mode $mode disksize $disksize datasize $datasize]
}
proc statstore {store hash {hex 0}} {
  if {$$hex} { set hexhash [binary encode hex $hash] }
  set path $store
  append path "/[string range $hexhash 0 1]"
  append path "/[string range $hexhash 2 3]"
  append path "/[string range $hexhash 4 5]/"
  append path "/[string range $hexhash 6 end]"
  if {![file exists $path]} return

  statbak $path
}

proc usage {} {
  global argv0
  puts stderr "usage: $argv0 command store ?args ...?"
  puts stderr "commands:"
  puts stderr "  init - initialize a store in store"
  puts stderr "  importlist ?listfile? - if listfile is ommitted, reads stdin"
  exit -1
}
proc die {reason} {
  global argv0
  puts stderr "$argv0: fatal: $reason"
  exit -2
}


if {[llength $argv] < 2} usage

set argv [lassign $argv command store]
set dbpath "$store/index.db"
set arpath "$store/archive"

if {$command == "init"} {
  if {[file exists $dbpath]} { die "won't overwrite \"$dbpath\"." }
  file mkdir $store
  file mkdir $arpath
  sqlite3 db $dbpath

  db eval {
    CREATE TABLE tarballs (name TEXT NOT NULL, type TEXT NOT NULL, ref TEXT NOT NULL, desc TEXT NOT NULL, date TEXT NOT NULL);
  }
  exit
}

if {[catch {sqlite3 db $dbpath -create false}]} { die "can't find a store at \"$store\"." }

switch -- $command {
  importlist {
    if {[llength $argv] > 1} usage
    if {[llength $argv] == 1} {
      set fd [open [lindex $argv 0]]
      set fname [lindex $argv 0]
    } else {
      set fd stdin
      set fname "pipeline"
    }

    set files [split [string trim [read $fd]] "\n"]
    set filelist {}
    close $fd

    foreach filename $files {
      if {![file exists $filename]} {
        puts stderr "warning: \"$filename\" doesn't exist"
        continue
      }

      set fd [open $filename rb]
      set data [read $fd]
      close $fd

      set hash [writestore $arpath $data 1]
      lappend filelist [string trimleft $filename "/"] $hash
    }

    set ref [writestore $arpath $filelist 1]
    set date [clock seconds]
    set rowid [db eval {
      INSERT INTO tarballs VALUES ($fname, "list", $ref, "", $date) RETURNING rowid;
    }]

    puts stderr "inserted as archive $rowid"
  }
}