if {![exists -command class]} { package require oo } class pkg { name "" latest "" descr "" changes "" url "" installed "" raw {} } set ::pkgmeta {} set ::diagmeta {} set ::muxdb {} pkg method _load {nm} { set name $nm set latest 0 foreach line [split [exec /bin/opkg list $nm] "\n"] { # betaftpd - 0.0.8pre17-1 - Description... if {[string match { *} $line]} { append descr $line } else { set xlatest $latest regexp {^[^ ]+ - ([^ ]+)(?: - (.*))?$} $line x \ xlatest descr if {[pkg vercompare $xlatest $latest] > 0} { set latest $xlatest } } } if {$descr eq ""} { $self loadraw if {[dict exists $raw description]} { set descr $raw(description) } } regexp {(.*) \[(.*)\]} $descr x descr changes set info [exec /bin/opkg list-installed $nm] regexp {^([^ ]+) - ([^ ]+)$} $info x x installed return $self } proc {pkg instverlist} {} {{cache {}}} { if {[llength $cache]} { return $cache } # Fetch details of installed packages foreach line [split [exec /bin/opkg list-installed] "\n"] { lassign $line pkg x ver set cache($pkg) $ver } return $cache } proc {pkg repolist} {} { set repos {} foreach line [split [file read /etc/opkg/opkg.conf] "\n"] { lassign $line tag repo if {$tag eq "src/gz"} { ladd repos $repo } } return $repos } proc {pkg getall} {{repo base}} { set pkglist {} # Fetch details of installed packages set installed [pkg instverlist] # Now build list of all packages if {[catch { set fp [open "/mod/var/opkg/$repo" r] } msg]} { error "Error opening repository, $msg" } set pkg {} set cur "" foreach line [split [$fp read] "\n"] { if {![regexp {^([^:]+): (.*)$} $line x tag val]} { if {[string equal -length 1 $line " "]} { # Continuation if {$lasttag ne ""} { append pkg($lasttag) " \ [string trim $line]" } } continue } set tag [string tolower $tag] if {$tag eq "package"} { if {$pkg ne ""} { set pkglist($name) $pkg } set name $val set iver 0 if {[dict exists $installed $val]} { set iver $installed($val) } set pkg [list \ "installed" $iver \ "repo" $repo \ ] set lasttag "" continue } set lasttag $tag set pkg($tag) $val } $fp close if {$pkg ne ""} { set pkglist($name) $pkg } return $pkglist } pkg method loadraw {} { set tag "" set txt "" set raw {} if {[file exists "/mod/var/opkg/info/$name.control"]} { set data [file read "/mod/var/opkg/info/$name.control"] } else { set data [exec /bin/opkg info $name] } foreach line [split $data "\n"] { if {$tag ne "" && [string match { *} $line]} { append raw($tag) $line continue } regexp {^([^:]+): (.*)$} $line x tag txt if {![dict exists $raw $tag]} { set tag [string tolower $tag] set raw($tag) $txt } else { set tag "" } } if {[dict exists $raw tags]} { set url $raw(tags) } } proc {pkg load} {nm} { return [[pkg] _load $nm] } pkg method is {what} { switch $what { installed { if {$installed eq ""} { return 0 } return 1 } upgradable { if {$installed eq $latest} { return 0 } return 1 } } return 0 } proc {pkg avail} {} { set inst_pkgs [pkg inst] set avail_pkgs {} foreach pkg [split [exec /bin/opkg list] "\n"] { if {[regexp {^ } $pkg]} { continue } if {[regexp {^([^ ]+)} $pkg name] == 0} { continue } if {$name ni $inst_pkgs && $name ni $avail_pkgs} { lappend avail_pkgs $name } #puts "New: $name
" } return $avail_pkgs } proc {pkg inst} {} { # Build a list of installed packages - just the names set inst_pkgs {} foreach pkg [split [exec /bin/opkg list-installed] "\n"] { if {[regexp {^([^ ]+)} $pkg name] == 0} { continue } if {$name ni $inst_pkgs} { lappend inst_pkgs $name } #puts "Inst: $name
" } return $inst_pkgs } proc {pkg upgr} {} { #webif - 0.5.3 - 0.5.7 set upgr_pkgs {} foreach pkg [split [exec /bin/opkg list-upgradable] "\n"] { if {[regexp {^([^ ]+)} $pkg name] == 0} { continue } lappend upgr_pkgs $name #puts "Upgr: $name
" } return $upgr_pkgs } proc {pkg loadmeta} {} { if {[llength $::pkgmeta]} { return } if {![file exists "/mod/var/pkg.meta"]} { catch {pkg fetchmeta} } else { set meta [open "/mod/var/pkg.meta" r] set ::pkgmeta [read $meta] $meta close } } proc {pkg loaddiagmeta} {} { if {[llength $::diagmeta]} { return } if {![file exists "/mod/var/diag.meta"]} { catch {pkg fetchdiagmeta} } else { set meta [open "/mod/var/diag.meta" r] set ::diagmeta [read $meta] $meta close } } proc {pkg fetchfile} {url} { set f [socket stream hpkg.tv:http] $f puts -nonewline "GET /hdrfoxt2/$url HTTP/1.1\r\n" $f puts -nonewline "Host: hpkg.tv\r\n" $f puts -nonewline "Connection: close\r\n" $f puts -nonewline "\r\n" # Skip headers in the response. set line [string trim [$f gets]] while {[string length $line]} { #puts "Web Header: $line" set line [string trim [$f gets]] } # Save the body set ret [$f read] $f close return $ret } proc {pkg fetchmeta} {} { set ::pkgmeta [pkg fetchfile pkg.meta] set ff [open "/mod/var/pkg.meta" w] puts $ff $::pkgmeta $ff close } proc {pkg fetchdiagmeta} {} { set ::diagmeta [pkg fetchfile diag.meta] set ff [open "/mod/var/diag.meta" w] puts $ff $::diagmeta $ff close } proc {pkg loadmuxdb} {} { if {[llength $::muxdb]} { return } if {![file exists "/mod/var/mux.db"]} { catch {pkg fetchmuxdb} } else { set meta [open "/mod/var/mux.db" r] set ::muxdb [read $meta] $meta close } } proc {pkg fetchmuxdb} {} { set ::muxdb [pkg fetchfile mux.db] set ff [open "/mod/var/mux.db" w] puts $ff $::muxdb $ff close } proc {pkg update} {} { exec /bin/opkg update } proc {pkg upgrade} {nm} { exec /bin/opkg upgrade $nm } proc {pkg vercompare} {v1 v2} { if {$v1 eq $v2} { return 0 } if {![regexp {^(.*)-([^-]+)$} $v1 x v1 r1]} { lassign [split $v1 -] v1 r1 } if {![regexp {^(.*)-([^-]+)$} $v2 x v2 r2]} { lassign [split $v2 -] v2 r2 } foreach a [split $v1 .] b [split $v2 .] { if {$b eq "" || $a > $b} { return 1 } if {$a eq "" || $a < $b} { return -1 } } if {$r2 eq "" || $r1 > $r2} { return 1 } if {$r1 eq "" || $r2 > $r1} { return -1 } return [string compare $v1 $v2] }