Diff

Differences From Artifact [07f0ced01b]:

To Artifact [58a43bb4f1]:


     1      1   #! /usr/bin/env tclsh
     2      2   
     3      3   package require http 2.7
     4      4   package require sqlite3
     5      5   
     6      6   namespace eval ::appfs {
     7         -	variable sites [list]
     8      7   	variable cachedir "/tmp/appfs-cache"
     9      8   
    10      9   	proc _hash_sep {hash {seps 4}} {
    11     10   		for {set idx 0} {$idx < $seps} {incr idx} {
    12     11   			append retval "[string range $hash [expr {$idx * 2}] [expr {($idx * 2) + 1}]]/"
    13     12   		}
    14     13   		append retval "[string range $hash [expr {$idx * 2}] end]"
................................................................................
    40     39   			} else {
    41     40   				file delete -force -- $tmpfile
    42     41   			}
    43     42   		}
    44     43   
    45     44   		return $file
    46     45   	}
           46  +
           47  +	proc _db {args} {
           48  +		return [uplevel 1 [list ::appfs::db {*}$args]]
           49  +	}
           50  +
           51  +	proc init {} {
           52  +		if {[info exists ::appfs::init_called]} {
           53  +			return
           54  +		}
           55  +
           56  +		set ::appfs::init_called 1
           57  +
           58  +		if {![info exists ::appfs::db]} {
           59  +			file mkdir $::appfs::cachedir
           60  +
           61  +			sqlite3 ::appfs::db [file join $::appfs::cachedir cache.db]
           62  +		}
           63  +
           64  +		_db eval {CREATE TABLE IF NOT EXISTS packages(hostname, sha1, package, version, os, cpuArch, isLatest);}
           65  +		_db eval {CREATE TABLE IF NOT EXISTS files(package_sha1, type, time, source, size, file_sha1, file_name, file_directory);}
           66  +	}
    47     67   
    48     68   	proc getindex {hostname} {
    49     69   		if {[string match "*\[/~\]*" $hostname]} {
    50     70   			return -code error "Invalid hostname"
    51     71   		}
    52     72   
    53     73   		set url "http://$hostname/appfs/index"
................................................................................
    96    116   			}
    97    117   
    98    118   			if {![regexp {^[0-9a-f]*$} $pkgInfo(hash)]} {
    99    119   				continue
   100    120   			}
   101    121   
   102    122   			set packages($pkgInfo(package)) [array get pkgInfo]
          123  +
          124  +			# Do not do any additional work if we already have this package
          125  +			set existing_packages [_db eval {SELECT package FROM packages WHERE hostname = $hostname AND sha1 = $pkgInfo(hash);}]
          126  +			if {[lsearch -exact $existing_packages $pkgInfo(package)] != -1} {
          127  +				continue
          128  +			}
          129  +
          130  +			if {$pkgInfo(isLatest)} {
          131  +				_db eval {UPDATE packages SET isLatest = 0 WHERE hostname = $hostname AND package = $pkgInfo($package) AND os = $pkgInfo($package) AND cpuArch = $pkgInfo(cpuArch);}
          132  +			}
          133  +
          134  +			_db eval {INSERT INTO packages (hostname, sha1, package, version, os, cpuArch, isLatest) VALUES ($hostname, $pkgInfo(hash), $pkgInfo(package), $pkgInfo(version), $pkgInfo(os), $pkgInfo(cpuArch), $pkgInfo(isLatest) );}
          135  +
          136  +			set file [download $hostname $pkgInfo(hash)]
          137  +			set fd [open $file]
          138  +			set pkgdata [read $fd]
          139  +			close $fd
          140  +
          141  +			foreach line [split $pkgdata "\n"] {
          142  +				set line [string trim $line]
          143  +
          144  +				if {[string match "*/*" $line]} {
          145  +					continue
          146  +				}
          147  +
          148  +				if {$line == ""} {
          149  +					continue
          150  +				}
          151  +
          152  +				set work [split $line ","]
          153  +
          154  +				unset -nocomplain fileInfo
          155  +				set fileInfo(type) [lindex $work 0]
          156  +				set fileInfo(time) [lindex $work 1]
          157  +				set fileInfo(name) [lindex $work end]
          158  +
          159  +				set fileInfo(name) [split [string trim $fileInfo(name) "/"] "/"]
          160  +				set fileInfo(directory) [join [lrange $fileInfo(name) 0 end-1] "/"]
          161  +				set fileInfo(name) [lindex $fileInfo(name) end]
          162  +
          163  +				set work [lrange $work 2 end-1]
          164  +				switch -- $fileInfo(type) {
          165  +					"file" {
          166  +						set fileInfo(size) [lindex $work 0]
          167  +						set fileInfo(sha1) [lindex $work 1]
          168  +					}
          169  +					"symlink" {
          170  +						set fileInfo(source) [lindex $work 0]
          171  +					}
          172  +				}
          173  +
          174  +				_db eval {INSERT INTO files (package_sha1, type, time, source, size, file_sha1, file_name, file_directory) VALUES ($pkgInfo(hash), $fileInfo(type), $fileInfo(time), $fileInfo(source), $fileInfo(size), $fileInfo(sha1), $fileInfo(name), $fileInfo(directory) );}
          175  +			}
   103    176   		}
   104    177   
   105         -		return [array get packages]
          178  +		return COMPLETE
   106    179   	}
   107    180   
   108    181   	proc download {hostname hash {method sha1}} {
   109    182   		set url "http://$hostname/appfs/$method/$hash"
   110    183   		set file [_cachefile $url $hash]
   111    184   
   112    185   		if {![file exists $file]} {
   113    186   			return -code error "Unable to fetch"
   114    187   		}
   115    188   
   116    189   		return $file
   117    190   	}
   118    191   }