#!/bin/env tclsh

package require sqlite3
package require Thread

set init {
  package require sha256

  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}} {
    set hexhash $hash
    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}} {
    set hexhash $hash
    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

    dict replace [statbak $path] path $path
  }
}
eval $init

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"
  puts stderr "  print hash - prints the contents of <hash> on stdout"
  puts stderr "  stat hash - prints metadata about <hash>"
  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\"." }

set fd [open /proc/cpuinfo r]
set nproc [llength [regexp -all -lineanchor -inline "^processor" [read $fd]]]
close $fd
set pool [tpool::create -maxworkers $nproc -initcmd [concat $init "; " [list set arpath $arpath]]]

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 joblist {}
    set filelist {}
    if {$fd != "stdin"} { close $fd }

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

      set script [concat [list set filename $filename] "; " {
        set fd [open $filename rb]
        set data [read $fd]
        close $fd

        set hash [writestore $arpath $data 1]
        return [list [string trimleft $filename "/"] $hash]
      }]

      lappend joblist [tpool::post $pool $script]
    }

    foreach job $joblist {
      tpool::wait $pool $job
      append filelist " [tpool::get $pool $job]"
    }

    set filelist [lsort -stride 2 $filelist]

    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 with hash $ref"
  }

  print {
    if {[llength $argv] != 1} usage

    set stat [statstore $arpath [lindex $argv 0] 1]
    if {$stat == {}} { die "unknown hash" }

    puts [readstore $arpath [lindex $argv 0] 1]
  }
  stat {
    if {[llength $argv] != 1} usage

    set stat [statstore $arpath [lindex $argv 0] 1]
    if {$stat == {}} { die "unknown hash" }

    puts "file [lindex $argv 0]:"
    puts "  version: [dict get $stat ver]"
    puts "  compression: [dict get $stat mode]"
    if {[dict get $stat mode] != "raw"} {
      puts "  compressed size (bytes): [dict get $stat disksize]"
    }
    puts "  data size (bytes): [dict get $stat datasize]"
  }

  default usage
}