2011-06-28 00:20:31 +00:00
|
|
|
|
2020-12-14 14:06:48 +00:00
|
|
|
if {![exists -command class]} { package require oo }
|
2011-06-28 00:20:31 +00:00
|
|
|
|
|
|
|
class pkg {
|
|
|
|
name ""
|
2011-07-11 23:29:21 +00:00
|
|
|
latest ""
|
2011-06-28 00:20:31 +00:00
|
|
|
descr ""
|
2014-02-03 21:42:20 +00:00
|
|
|
changes ""
|
|
|
|
url ""
|
2011-06-28 00:20:31 +00:00
|
|
|
installed ""
|
2014-02-03 21:42:20 +00:00
|
|
|
raw {}
|
2011-06-28 00:20:31 +00:00
|
|
|
}
|
|
|
|
|
2011-07-11 23:29:21 +00:00
|
|
|
set ::pkgmeta {}
|
2012-11-25 00:22:18 +00:00
|
|
|
set ::diagmeta {}
|
2018-03-12 23:41:25 +00:00
|
|
|
set ::muxdb {}
|
2011-07-11 23:29:21 +00:00
|
|
|
|
|
|
|
pkg method _load {nm} {
|
2011-06-28 00:20:31 +00:00
|
|
|
set name $nm
|
2016-12-28 08:38:07 +00:00
|
|
|
set latest 0
|
2012-01-06 23:39:15 +00:00
|
|
|
foreach line [split [exec /bin/opkg list $nm] "\n"] {
|
|
|
|
# betaftpd - 0.0.8pre17-1 - Description...
|
2014-02-03 21:42:20 +00:00
|
|
|
if {[string match { *} $line]} {
|
|
|
|
append descr $line
|
|
|
|
} else {
|
2017-01-15 15:26:35 +00:00
|
|
|
set xlatest $latest
|
|
|
|
regexp {^[^ ]+ - ([^ ]+)(?: - (.*))?$} $line x \
|
|
|
|
xlatest descr
|
2016-12-28 08:38:07 +00:00
|
|
|
if {[pkg vercompare $xlatest $latest] > 0} {
|
|
|
|
set latest $xlatest
|
|
|
|
}
|
2014-02-03 21:42:20 +00:00
|
|
|
}
|
2012-01-06 23:39:15 +00:00
|
|
|
}
|
2017-02-01 17:43:05 +00:00
|
|
|
if {$descr eq ""} {
|
|
|
|
$self loadraw
|
|
|
|
if {[dict exists $raw description]} {
|
|
|
|
set descr $raw(description)
|
|
|
|
}
|
|
|
|
}
|
2014-02-03 21:42:20 +00:00
|
|
|
regexp {(.*) \[(.*)\]} $descr x descr changes
|
2011-07-11 23:29:21 +00:00
|
|
|
set info [exec /bin/opkg list-installed $nm]
|
2014-02-03 21:42:20 +00:00
|
|
|
regexp {^([^ ]+) - ([^ ]+)$} $info x x installed
|
2011-06-28 00:20:31 +00:00
|
|
|
|
2011-07-11 23:29:21 +00:00
|
|
|
return $self
|
|
|
|
}
|
|
|
|
|
2017-02-01 17:43:05 +00:00
|
|
|
proc {pkg instverlist} {} {{cache {}}} {
|
|
|
|
if {[llength $cache]} { return $cache }
|
2016-02-10 23:41:02 +00:00
|
|
|
|
|
|
|
# Fetch details of installed packages
|
|
|
|
foreach line [split [exec /bin/opkg list-installed] "\n"] {
|
|
|
|
lassign $line pkg x ver
|
2017-02-01 17:43:05 +00:00
|
|
|
set cache($pkg) $ver
|
2016-02-10 23:41:02 +00:00
|
|
|
}
|
2017-02-01 17:43:05 +00:00
|
|
|
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]
|
2016-02-10 23:41:02 +00:00
|
|
|
|
|
|
|
# Now build list of all packages
|
|
|
|
|
|
|
|
if {[catch { set fp [open "/mod/var/opkg/$repo" r] } msg]} {
|
|
|
|
error "Error opening repository, $msg"
|
|
|
|
}
|
2017-01-31 23:31:19 +00:00
|
|
|
|
2016-02-10 23:41:02 +00:00
|
|
|
set pkg {}
|
2017-01-31 23:31:19 +00:00
|
|
|
set cur ""
|
2016-02-10 23:41:02 +00:00
|
|
|
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
|
2017-02-01 17:43:05 +00:00
|
|
|
set iver 0
|
2016-02-10 23:41:02 +00:00
|
|
|
if {[dict exists $installed $val]} {
|
2017-02-01 17:43:05 +00:00
|
|
|
set iver $installed($val)
|
2016-02-10 23:41:02 +00:00
|
|
|
}
|
2017-02-01 17:43:05 +00:00
|
|
|
|
|
|
|
set pkg [list \
|
|
|
|
"installed" $iver \
|
|
|
|
"repo" $repo \
|
|
|
|
]
|
2016-02-10 23:41:02 +00:00
|
|
|
set lasttag ""
|
|
|
|
continue
|
|
|
|
}
|
|
|
|
set lasttag $tag
|
|
|
|
set pkg($tag) $val
|
|
|
|
}
|
|
|
|
$fp close
|
|
|
|
if {$pkg ne ""} {
|
|
|
|
set pkglist($name) $pkg
|
|
|
|
}
|
|
|
|
|
|
|
|
return $pkglist
|
|
|
|
}
|
|
|
|
|
2014-02-03 21:42:20 +00:00
|
|
|
pkg method loadraw {} {
|
|
|
|
set tag ""
|
|
|
|
set txt ""
|
|
|
|
set raw {}
|
2017-02-01 17:43:05 +00:00
|
|
|
|
|
|
|
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]
|
|
|
|
}
|
2021-02-24 14:47:11 +00:00
|
|
|
|
2017-02-01 17:43:05 +00:00
|
|
|
foreach line [split $data "\n"] {
|
2014-02-03 21:42:20 +00:00
|
|
|
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) }
|
|
|
|
}
|
|
|
|
|
2011-07-11 23:29:21 +00:00
|
|
|
proc {pkg load} {nm} {
|
|
|
|
return [[pkg] _load $nm]
|
2011-06-28 00:20:31 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
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} {} {
|
2011-07-11 23:29:21 +00:00
|
|
|
set inst_pkgs [pkg inst]
|
2011-06-28 00:20:31 +00:00
|
|
|
set avail_pkgs {}
|
|
|
|
foreach pkg [split [exec /bin/opkg list] "\n"] {
|
2015-02-01 01:28:03 +00:00
|
|
|
if {[regexp {^ } $pkg]} { continue }
|
2011-07-11 23:29:21 +00:00
|
|
|
if {[regexp {^([^ ]+)} $pkg name] == 0} { continue }
|
2014-02-03 21:42:20 +00:00
|
|
|
if {$name ni $inst_pkgs && $name ni $avail_pkgs} {
|
|
|
|
lappend avail_pkgs $name
|
|
|
|
}
|
2011-07-11 23:29:21 +00:00
|
|
|
#puts "New: $name<br>"
|
2011-06-28 00:20:31 +00:00
|
|
|
}
|
|
|
|
return $avail_pkgs
|
|
|
|
}
|
|
|
|
|
2011-07-11 23:29:21 +00:00
|
|
|
proc {pkg inst} {} {
|
2011-06-28 00:20:31 +00:00
|
|
|
# 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 }
|
2014-02-03 21:42:20 +00:00
|
|
|
if {$name ni $inst_pkgs} {
|
|
|
|
lappend inst_pkgs $name
|
|
|
|
}
|
2011-06-28 00:20:31 +00:00
|
|
|
#puts "Inst: $name<br>"
|
|
|
|
}
|
|
|
|
return $inst_pkgs
|
|
|
|
}
|
|
|
|
|
2011-07-11 23:29:21 +00:00
|
|
|
proc {pkg upgr} {} {
|
2011-06-28 00:20:31 +00:00
|
|
|
#webif - 0.5.3 - 0.5.7
|
|
|
|
set upgr_pkgs {}
|
|
|
|
foreach pkg [split [exec /bin/opkg list-upgradable] "\n"] {
|
2011-07-11 23:29:21 +00:00
|
|
|
if {[regexp {^([^ ]+)} $pkg name] == 0} { continue }
|
|
|
|
lappend upgr_pkgs $name
|
|
|
|
#puts "Upgr: $name<br>"
|
2011-06-28 00:20:31 +00:00
|
|
|
}
|
|
|
|
return $upgr_pkgs
|
|
|
|
}
|
|
|
|
|
2011-07-11 23:29:21 +00:00
|
|
|
proc {pkg loadmeta} {} {
|
|
|
|
if {[llength $::pkgmeta]} { return }
|
|
|
|
if {![file exists "/mod/var/pkg.meta"]} {
|
2012-10-08 20:16:27 +00:00
|
|
|
catch {pkg fetchmeta}
|
2011-07-11 23:29:21 +00:00
|
|
|
} else {
|
|
|
|
set meta [open "/mod/var/pkg.meta" r]
|
|
|
|
set ::pkgmeta [read $meta]
|
|
|
|
$meta close
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2012-11-25 00:22:18 +00:00
|
|
|
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
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2014-06-19 18:50:53 +00:00
|
|
|
proc {pkg fetchfile} {url} {
|
2021-02-24 14:47:11 +00:00
|
|
|
set f [socket stream hpkg.tv:http]
|
2014-06-19 18:50:53 +00:00
|
|
|
$f puts -nonewline "GET /hdrfoxt2/$url HTTP/1.1\r\n"
|
|
|
|
$f puts -nonewline "Host: hpkg.tv\r\n"
|
2014-01-18 00:26:33 +00:00
|
|
|
$f puts -nonewline "Connection: close\r\n"
|
2011-07-11 23:29:21 +00:00
|
|
|
$f puts -nonewline "\r\n"
|
|
|
|
|
2014-06-19 18:50:53 +00:00
|
|
|
# Skip headers in the response.
|
2011-07-11 23:29:21 +00:00
|
|
|
set line [string trim [$f gets]]
|
|
|
|
while {[string length $line]} {
|
2014-06-19 18:50:53 +00:00
|
|
|
#puts "Web Header: $line"
|
2011-07-11 23:29:21 +00:00
|
|
|
set line [string trim [$f gets]]
|
|
|
|
}
|
2021-02-24 14:47:11 +00:00
|
|
|
|
2014-06-19 18:50:53 +00:00
|
|
|
# Save the body
|
|
|
|
set ret [$f read]
|
2011-07-11 23:29:21 +00:00
|
|
|
$f close
|
2014-06-19 18:50:53 +00:00
|
|
|
return $ret
|
|
|
|
}
|
|
|
|
|
|
|
|
proc {pkg fetchmeta} {} {
|
|
|
|
set ::pkgmeta [pkg fetchfile pkg.meta]
|
2011-07-11 23:29:21 +00:00
|
|
|
|
|
|
|
set ff [open "/mod/var/pkg.meta" w]
|
|
|
|
puts $ff $::pkgmeta
|
|
|
|
$ff close
|
|
|
|
}
|
|
|
|
|
2012-11-25 00:22:18 +00:00
|
|
|
proc {pkg fetchdiagmeta} {} {
|
2014-06-19 18:50:53 +00:00
|
|
|
set ::diagmeta [pkg fetchfile diag.meta]
|
2012-11-25 00:22:18 +00:00
|
|
|
|
|
|
|
set ff [open "/mod/var/diag.meta" w]
|
|
|
|
puts $ff $::diagmeta
|
|
|
|
$ff close
|
|
|
|
}
|
|
|
|
|
2018-03-12 23:41:25 +00:00
|
|
|
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
|
|
|
|
}
|
|
|
|
|
2014-02-03 23:06:38 +00:00
|
|
|
proc {pkg update} {} {
|
|
|
|
exec /bin/opkg update
|
|
|
|
}
|
|
|
|
|
|
|
|
proc {pkg upgrade} {nm} {
|
|
|
|
exec /bin/opkg upgrade $nm
|
|
|
|
}
|
|
|
|
|
2016-02-10 23:41:02 +00:00
|
|
|
proc {pkg vercompare} {v1 v2} {
|
|
|
|
if {$v1 eq $v2} { return 0 }
|
|
|
|
|
2016-12-30 12:20:24 +00:00
|
|
|
if {![regexp {^(.*)-([^-]+)$} $v1 x v1 r1]} {
|
|
|
|
lassign [split $v1 -] v1 r1
|
|
|
|
}
|
|
|
|
|
|
|
|
if {![regexp {^(.*)-([^-]+)$} $v2 x v2 r2]} {
|
|
|
|
lassign [split $v2 -] v2 r2
|
|
|
|
}
|
2016-02-10 23:41:02 +00:00
|
|
|
|
|
|
|
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 }
|
2016-12-30 12:20:24 +00:00
|
|
|
return [string compare $v1 $v2]
|
2016-02-10 23:41:02 +00:00
|
|
|
}
|
|
|
|
|