| | 1 | #!/usr/bin/perl -w |
| | 2 | ############################################################################### |
| | 3 | # # |
| | 4 | # IPFire.org - A linux based firewall # |
| | 5 | # Copyright (C) 2007-2021 IPFire Team <info@ipfire.org> # |
| | 6 | # # |
| | 7 | # This program is free software: you can redistribute it and/or modify # |
| | 8 | # it under the terms of the GNU General Public License as published by # |
| | 9 | # the Free Software Foundation, either version 3 of the License, or # |
| | 10 | # (at your option) any later version. # |
| | 11 | # # |
| | 12 | # This program is distributed in the hope that it will be useful, # |
| | 13 | # but WITHOUT ANY WARRANTY; without even the implied warranty of # |
| | 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # |
| | 15 | # GNU General Public License for more details. # |
| | 16 | # # |
| | 17 | # You should have received a copy of the GNU General Public License # |
| | 18 | # along with this program. If not, see <http://www.gnu.org/licenses/>. # |
| | 19 | # # |
| | 20 | ############################################################################### |
| | 21 | |
| | 22 | require "/opt/pakfire/etc/pakfire.conf"; |
| | 23 | require "/var/ipfire/general-functions.pl"; |
| | 24 | |
| | 25 | use File::Basename; |
| | 26 | use File::Copy; |
| | 27 | use LWP::UserAgent; |
| | 28 | use HTTP::Response; |
| | 29 | use HTTP::Headers; |
| | 30 | use HTTP::Message; |
| | 31 | use HTTP::Request; |
| | 32 | use Net::Ping; |
| | 33 | use URI; |
| | 34 | |
| | 35 | use Switch; |
| | 36 | |
| | 37 | package Pakfire; |
| | 38 | |
| | 39 | my @VALID_KEY_FINGERPRINTS = ( |
| | 40 | # 2018 |
| | 41 | "3ECA8AA4478208B924BB96206FEF7A8ED713594B", |
| | 42 | # 2007 |
| | 43 | "179740DC4D8C47DC63C099C74BDE364C64D96617", |
| | 44 | ); |
| | 45 | |
| | 46 | # A small color-hash :D |
| | 47 | my %color; |
| | 48 | $color{'normal'} = "\033[0m"; |
| | 49 | $color{'black'} = "\033[0;30m"; |
| | 50 | $color{'darkgrey'} = "\033[1;30m"; |
| | 51 | $color{'blue'} = "\033[0;34m"; |
| | 52 | $color{'lightblue'} = "\033[1;34m"; |
| | 53 | $color{'green'} = "\033[0;32m"; |
| | 54 | $color{'lightgreen'} = "\033[1;32m"; |
| | 55 | $color{'cyan'} = "\033[0;36m"; |
| | 56 | $color{'lightcyan'} = "\033[1;36m"; |
| | 57 | $color{'red'} = "\033[0;31m"; |
| | 58 | $color{'lightred'} = "\033[1;31m"; |
| | 59 | $color{'purple'} = "\033[0;35m"; |
| | 60 | $color{'lightpurple'} = "\033[1;35m"; |
| | 61 | $color{'brown'} = "\033[0;33m"; |
| | 62 | $color{'lightgrey'} = "\033[0;37m"; |
| | 63 | $color{'yellow'} = "\033[1;33m"; |
| | 64 | $color{'white'} = "\033[1;37m"; |
| | 65 | our $enable_colors = 1; |
| | 66 | |
| | 67 | my $final_data; |
| | 68 | my $total_size; |
| | 69 | my $bfile; |
| | 70 | |
| | 71 | my %pakfiresettings = (); |
| | 72 | &General::readhash("${General::swroot}/pakfire/settings", \%pakfiresettings); |
| | 73 | |
| | 74 | # Make version |
| | 75 | $Conf::version = &make_version(); |
| | 76 | |
| | 77 | # Pakfire lock file. |
| | 78 | our $lockfile = "/tmp/pakfire_lock"; |
| | 79 | |
| | 80 | sub message { |
| | 81 | my $message = shift; |
| | 82 | |
| | 83 | logger("$message"); |
| | 84 | if ( $enable_colors == 1 ) { |
| | 85 | if ("$message" =~ /ERROR/) { |
| | 86 | $message = "$color{'red'}$message$color{'normal'}"; |
| | 87 | } elsif ("$message" =~ /INFO/) { |
| | 88 | $message = "$color{'cyan'}$message$color{'normal'}"; |
| | 89 | } elsif ("$message" =~ /WARN/) { |
| | 90 | $message = "$color{'yellow'}$message$color{'normal'}"; |
| | 91 | } elsif ("$message" =~ /RESV/) { |
| | 92 | $message = "$color{'purple'}$message$color{'normal'}"; |
| | 93 | } elsif ("$message" =~ /INST/) { |
| | 94 | $message = "$color{'green'}$message$color{'normal'}"; |
| | 95 | } elsif ("$message" =~ /REMV/) { |
| | 96 | $message = "$color{'lightred'}$message$color{'normal'}"; |
| | 97 | } elsif ("$message" =~ /UPGR/) { |
| | 98 | $message = "$color{'lightblue'}$message$color{'normal'}"; |
| | 99 | } |
| | 100 | } |
| | 101 | print "$message\n"; |
| | 102 | |
| | 103 | } |
| | 104 | |
| | 105 | sub logger { |
| | 106 | my $log = shift; |
| | 107 | if ($log) { |
| | 108 | #system("echo \"`date`: $log\" >> /var/log/pakfire.log"); |
| | 109 | system("logger -t pakfire \"$log\""); |
| | 110 | } |
| | 111 | } |
| | 112 | |
| | 113 | sub usage { |
| | 114 | &Pakfire::message("Usage: pakfire <install|remove> [options] <pak(s)>"); |
| | 115 | &Pakfire::message(" <update> - Contacts the servers for new lists of paks."); |
| | 116 | &Pakfire::message(" <upgrade> - Installs the latest version of all paks."); |
| | 117 | &Pakfire::message(" <list> - Outputs a short list with all available paks."); |
| | 118 | &Pakfire::message(" <status> - Outputs a summary about available core upgrades, updates and a required reboot"); |
| | 119 | &Pakfire::message(""); |
| | 120 | &Pakfire::message(" Global options:"); |
| | 121 | &Pakfire::message(" --non-interactive --> Enables the non-interactive mode."); |
| | 122 | &Pakfire::message(" You won't see any question here."); |
| | 123 | &Pakfire::message(" -y --> Short for --non-interactive."); |
| | 124 | &Pakfire::message(" --no-colors --> Turns off the wonderful colors."); |
| | 125 | &Pakfire::message(""); |
| | 126 | exit 1; |
| | 127 | } |
| | 128 | |
| | 129 | sub fetchfile { |
| | 130 | my $getfile = shift; |
| | 131 | my $gethost = shift; |
| | 132 | my (@server, $host, $proto, $file, $i); |
| | 133 | my $allok = 0; |
| | 134 | |
| | 135 | use File::Basename; |
| | 136 | $bfile = basename("$getfile"); |
| | 137 | |
| | 138 | logger("DOWNLOAD STARTED: $getfile"); |
| | 139 | |
| | 140 | $i = 0; |
| | 141 | while (($allok == 0) && $i < 5) { |
| | 142 | $i++; |
| | 143 | |
| | 144 | if ("$gethost" eq "") { |
| | 145 | @server = selectmirror(); |
| | 146 | $proto = $server[0]; |
| | 147 | $host = $server[1]; |
| | 148 | $file = "$server[2]/$getfile"; |
| | 149 | } else { |
| | 150 | $host = $gethost; |
| | 151 | $file = $getfile; |
| | 152 | } |
| | 153 | |
| | 154 | $proto = "HTTPS" unless $proto; |
| | 155 | |
| | 156 | logger("DOWNLOAD INFO: Host: $host ($proto) - File: $file"); |
| | 157 | |
| | 158 | my $ua = LWP::UserAgent->new; |
| | 159 | $ua->agent("Pakfire/$Conf::version"); |
| | 160 | $ua->timeout(20); |
| | 161 | |
| | 162 | my %proxysettings=(); |
| | 163 | &General::readhash("${General::swroot}/proxy/advanced/settings", \%proxysettings); |
| | 164 | |
| | 165 | if ($proxysettings{'UPSTREAM_PROXY'}) { |
| | 166 | logger("DOWNLOAD INFO: Upstream proxy: \"$proxysettings{'UPSTREAM_PROXY'}\""); |
| | 167 | if ($proxysettings{'UPSTREAM_USER'}) { |
| | 168 | $ua->proxy(["http", "https"], "http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$proxysettings{'UPSTREAM_PROXY'}/"); |
| | 169 | logger("DOWNLOAD INFO: Logging in with \"$proxysettings{'UPSTREAM_USER'}\" against \"$proxysettings{'UPSTREAM_PROXY'}\""); |
| | 170 | } else { |
| | 171 | $ua->proxy(["http", "https"], "http://$proxysettings{'UPSTREAM_PROXY'}/"); |
| | 172 | } |
| | 173 | } |
| | 174 | |
| | 175 | $final_data = undef; |
| | 176 | |
| | 177 | my $url; |
| | 178 | switch ($proto) { |
| | 179 | case "HTTP" { $url = "http://$host/$file"; } |
| | 180 | case "HTTPS" { $url = "https://$host/$file"; } |
| | 181 | else { |
| | 182 | # skip all lines with unknown protocols |
| | 183 | logger("DOWNLOAD WARNING: Skipping Host: $host due to unknown protocol ($proto) in mirror database"); |
| | 184 | next; |
| | 185 | } |
| | 186 | } |
| | 187 | |
| | 188 | my $result = $ua->head($url); |
| | 189 | my $remote_headers = $result->headers; |
| | 190 | $total_size = $remote_headers->content_length; |
| | 191 | logger("DOWNLOAD INFO: $file has size of $total_size bytes"); |
| | 192 | |
| | 193 | my $response = $ua->get($url, ':content_cb' => \&callback ); |
| | 194 | message(""); |
| | 195 | |
| | 196 | my $code = $response->code(); |
| | 197 | my $log = $response->status_line; |
| | 198 | logger("DOWNLOAD INFO: HTTP-Status-Code: $code - $log"); |
| | 199 | |
| | 200 | if ( $code eq "500" ) { |
| | 201 | message("Giving up: There was no chance to get the file \"$getfile\" from any available server.\nThere was an error on the way. Please fix it."); |
| | 202 | return 1; |
| | 203 | } |
| | 204 | |
| | 205 | if ($response->is_success) { |
| | 206 | if (open(FILE, ">$Conf::tmpdir/$bfile")) { |
| | 207 | print FILE $final_data; |
| | 208 | close(FILE); |
| | 209 | logger("DOWNLOAD INFO: File received. Start checking signature..."); |
| | 210 | if (&valid_signature("$Conf::tmpdir/$bfile")) { |
| | 211 | logger("DOWNLOAD INFO: Signature of $bfile is fine."); |
| | 212 | move("$Conf::tmpdir/$bfile","$Conf::cachedir/$bfile"); |
| | 213 | } else { |
| | 214 | message("DOWNLOAD ERROR: The downloaded file ($file) wasn't verified by IPFire.org. Sorry - Exiting..."); |
| | 215 | my $ntp = `ntpdate -q -t 10 pool.ntp.org 2>/dev/null | tail -1`; |
| | 216 | if ( $ntp !~ /time\ server(.*)offset(.*)/ ){message("TIME ERROR: Unable to get the nettime, this may lead to the verification error.");} |
| | 217 | else { $ntp =~ /time\ server(.*)offset(.*)/; message("TIME INFO: Time Server$1has$2 offset to localtime.");} |
| | 218 | exit 1; |
| | 219 | } |
| | 220 | logger("DOWNLOAD FINISHED: $file"); |
| | 221 | $allok = 1; |
| | 222 | return 0; |
| | 223 | } else { |
| | 224 | logger("DOWNLOAD ERROR: Could not open $Conf::tmpdir/$bfile for writing."); |
| | 225 | } |
| | 226 | } else { |
| | 227 | logger("DOWNLOAD ERROR: $log"); |
| | 228 | } |
| | 229 | } |
| | 230 | message("DOWNLOAD ERROR: There was no chance to get the file \"$getfile\" from any available server.\nMay be you should run \"pakfire update\" to get some new servers."); |
| | 231 | return 1; |
| | 232 | } |
| | 233 | |
| | 234 | sub getmirrors { |
| | 235 | my $force = shift; |
| | 236 | my $age; |
| | 237 | |
| | 238 | use File::Copy; |
| | 239 | |
| | 240 | if ( -e "$Conf::dbdir/lists/server-list.db" ) { |
| | 241 | my @stat = stat("$Conf::dbdir/lists/server-list.db"); |
| | 242 | my $time = time(); |
| | 243 | $age = $time - $stat[9]; |
| | 244 | $force = "force" if ("$age" >= "3600"); |
| | 245 | logger("MIRROR INFO: server-list.db is $age seconds old. - DEBUG: $force"); |
| | 246 | } else { |
| | 247 | # Force an update. |
| | 248 | $force = "force"; |
| | 249 | } |
| | 250 | |
| | 251 | if ("$force" eq "force") { |
| | 252 | fetchfile("$Conf::version/lists/server-list.db", "$Conf::mainserver"); |
| | 253 | move("$Conf::cachedir/server-list.db", "$Conf::dbdir/lists/server-list.db"); |
| | 254 | } |
| | 255 | } |
| | 256 | |
| | 257 | sub getcoredb { |
| | 258 | my $force = shift; |
| | 259 | my $age; |
| | 260 | |
| | 261 | use File::Copy; |
| | 262 | |
| | 263 | if ( -e "$Conf::dbdir/lists/core-list.db" ) { |
| | 264 | my @stat = stat("$Conf::dbdir/lists/core-list.db"); |
| | 265 | my $time = time(); |
| | 266 | $age = $time - $stat[9]; |
| | 267 | $force = "force" if ("$age" >= "3600"); |
| | 268 | logger("CORE INFO: core-list.db is $age seconds old. - DEBUG: $force"); |
| | 269 | } else { |
| | 270 | # Force an update. |
| | 271 | $force = "force"; |
| | 272 | } |
| | 273 | |
| | 274 | if ("$force" eq "force") { |
| | 275 | fetchfile("lists/core-list.db", ""); |
| | 276 | move("$Conf::cachedir/core-list.db", "$Conf::dbdir/lists/core-list.db"); |
| | 277 | } |
| | 278 | } |
| | 279 | |
| | 280 | sub valid_signature($) { |
| | 281 | my $filename = shift; |
| | 282 | |
| | 283 | open(my $cmd, "gpg --verify --status-fd 1 \"$filename\" 2>/dev/null |"); |
| | 284 | while (<$cmd>) { |
| | 285 | # Process valid signature lines |
| | 286 | if (/VALIDSIG ([A-Z0-9]+)/) { |
| | 287 | # Check if we know the key |
| | 288 | foreach my $key (@VALID_KEY_FINGERPRINTS) { |
| | 289 | # Signature is valid |
| | 290 | return 1 if ($key eq $1); |
| | 291 | } |
| | 292 | } |
| | 293 | } |
| | 294 | close($cmd); |
| | 295 | |
| | 296 | # Signature is invalid |
| | 297 | return 0; |
| | 298 | } |
| | 299 | |
| | 300 | sub selectmirror { |
| | 301 | if (defined ${Conf::mirror}) { |
| | 302 | my $uri = URI->new("${Conf::mirror}"); |
| | 303 | |
| | 304 | # Only accept HTTPS mirrors |
| | 305 | if ($uri->scheme eq "https") { |
| | 306 | return ("HTTPS", $uri->host, $uri->path . "/" . ${Conf::version}); |
| | 307 | } else { |
| | 308 | message("MIRROR ERROR: Unsupported mirror: " . ${Conf::mirror}); |
| | 309 | } |
| | 310 | } |
| | 311 | |
| | 312 | ### Check if there is a current server list and read it. |
| | 313 | # If there is no list try to get one. |
| | 314 | my $count = 0; |
| | 315 | while (!(open(FILE, "<$Conf::dbdir/lists/server-list.db")) && ($count lt 5)) { |
| | 316 | $count++; |
| | 317 | getmirrors("noforce"); |
| | 318 | } |
| | 319 | if ($count == 5) { |
| | 320 | message("MIRROR ERROR: Could not find or download a server list"); |
| | 321 | exit 1; |
| | 322 | } |
| | 323 | my @lines = <FILE>; |
| | 324 | close(FILE); |
| | 325 | |
| | 326 | ### Count the number of the servers in the list |
| | 327 | my $scount = 0; |
| | 328 | my @newlines; |
| | 329 | foreach (@lines) { |
| | 330 | if ("$_" =~ /.*;.*;.*;/ ) { |
| | 331 | push(@newlines,$_); |
| | 332 | $scount++; |
| | 333 | } |
| | 334 | } |
| | 335 | logger("MIRROR INFO: $scount servers found in list"); |
| | 336 | |
| | 337 | if ($scount eq 0) { |
| | 338 | logger("MIRROR INFO: Could not find any servers. Falling back to main server $Conf::mainserver"); |
| | 339 | return ("HTTPS", $Conf::mainserver, "/$Conf::version"); |
| | 340 | } |
| | 341 | |
| | 342 | ### Choose a random server and test if it is online |
| | 343 | # If the check fails try a new server. |
| | 344 | # This will never give up. |
| | 345 | my $servers = 0; |
| | 346 | while (1) { |
| | 347 | $server = int(rand($scount) + 1); |
| | 348 | $servers = 0; |
| | 349 | my ($line, $proto, $path, $host); |
| | 350 | my @templine; |
| | 351 | foreach $line (@newlines) { |
| | 352 | $servers++; |
| | 353 | if ($servers eq $server) { |
| | 354 | @templine = split(/\;/, $line); |
| | 355 | $proto = $templine[0]; |
| | 356 | $host = $templine[1]; |
| | 357 | $path = $templine[2]; |
| | 358 | |
| | 359 | return ($proto, $host, $path); |
| | 360 | } |
| | 361 | } |
| | 362 | } |
| | 363 | } |
| | 364 | |
| | 365 | sub dbgetlist { |
| | 366 | ### Update the database if the file is older than one day. |
| | 367 | # If you pass &Pakfire::dbgetlist(force) the list will be downloaded. |
| | 368 | # Usage is always with an argument. |
| | 369 | my $force = shift; |
| | 370 | my $age; |
| | 371 | |
| | 372 | use File::Copy; |
| | 373 | |
| | 374 | if ( -e "$Conf::dbdir/lists/packages_list.db" ) { |
| | 375 | my @stat = stat("$Conf::dbdir/lists/packages_list.db"); |
| | 376 | my $time = time(); |
| | 377 | $age = $time - $stat[9]; |
| | 378 | $force = "force" if ("$age" >= "3600"); |
| | 379 | logger("DB INFO: packages_list.db is $age seconds old. - DEBUG: $force"); |
| | 380 | } else { |
| | 381 | # Force an update. |
| | 382 | $force = "force"; |
| | 383 | } |
| | 384 | |
| | 385 | if ("$force" eq "force") { |
| | 386 | fetchfile("lists/packages_list.db", ""); |
| | 387 | move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db"); |
| | 388 | } |
| | 389 | |
| | 390 | # Update the meta database if new packages was in the package list |
| | 391 | my $file; |
| | 392 | my $line; |
| | 393 | my $prog; |
| | 394 | my %metadata; |
| | 395 | my @templine; |
| | 396 | |
| | 397 | open(FILE, "<$Conf::dbdir/lists/packages_list.db"); |
| | 398 | my @db = <FILE>; |
| | 399 | close(FILE); |
| | 400 | |
| | 401 | opendir(DIR,"$Conf::dbdir/meta"); |
| | 402 | my @files = readdir(DIR); |
| | 403 | closedir(DIR); |
| | 404 | foreach $file (@files) { |
| | 405 | next if ( $file eq "." ); |
| | 406 | next if ( $file eq ".." ); |
| | 407 | next if ( $file eq "meta-" ); |
| | 408 | next if ( $file =~ /^old/ ); |
| | 409 | %metadata = parsemetafile("$Conf::dbdir/meta/$file"); |
| | 410 | |
| | 411 | foreach $prog (@db) { |
| | 412 | @templine = split(/\;/,$prog); |
| | 413 | if (("$metadata{'Name'}" eq "$templine[0]") && ("$metadata{'Release'}" ne "$templine[2]")) { |
| | 414 | move("$Conf::dbdir/meta/meta-$metadata{'Name'}","$Conf::dbdir/meta/old_meta-$metadata{'Name'}"); |
| | 415 | fetchfile("meta/meta-$metadata{'Name'}", ""); |
| | 416 | move("$Conf::cachedir/meta-$metadata{'Name'}", "$Conf::dbdir/meta/meta-$metadata{'Name'}"); |
| | 417 | } |
| | 418 | } |
| | 419 | } |
| | 420 | } |
| | 421 | |
| | 422 | sub dblist { |
| | 423 | ### This subroutine lists the packages. |
| | 424 | # You may also pass a filter: &Pakfire::dblist(filter) |
| | 425 | # Usage is always with two arguments. |
| | 426 | # filter may be: all, notinstalled, installed |
| | 427 | my $filter = shift; |
| | 428 | my $forweb = shift; |
| | 429 | my @updatepaks; |
| | 430 | my $file; |
| | 431 | my $line; |
| | 432 | my $prog; |
| | 433 | my %metadata; |
| | 434 | my @templine; |
| | 435 | |
| | 436 | ### Make sure that the list is not outdated. |
| | 437 | #dbgetlist("noforce"); |
| | 438 | |
| | 439 | open(FILE, "<$Conf::dbdir/lists/packages_list.db"); |
| | 440 | my @db = <FILE>; |
| | 441 | close(FILE); |
| | 442 | |
| | 443 | if ("$filter" eq "upgrade") { |
| | 444 | if ("$forweb" ne "forweb" && "$forweb" ne "notice" ) {getcoredb("noforce");} |
| | 445 | eval(`grep "core_" $Conf::dbdir/lists/core-list.db`); |
| | 446 | if ("$core_release" > "$Conf::core_mine") { |
| | 447 | if ("$forweb" eq "forweb") { |
| | 448 | print "<option value=\"core\">Core-Update -- $Conf::version -- Release: $Conf::core_mine -> $core_release</option>\n"; |
| | 449 | } |
| | 450 | elsif ("$forweb" eq "notice") { |
| | 451 | print "<br /><br /><br /><a href='pakfire.cgi'>$Lang::tr{'core notice 1'} $Conf::core_mine $Lang::tr{'core notice 2'} $core_release $Lang::tr{'core notice 3'}</a>"; |
| | 452 | } else { |
| | 453 | my $command = "Core-Update $Conf::version\nRelease: $Conf::core_mine -> $core_release\n"; |
| | 454 | if ("$Pakfire::enable_colors" eq "1") { |
| | 455 | print "$color{'lila'}$command$color{'normal'}\n"; |
| | 456 | } else { |
| | 457 | print "$command\n"; |
| | 458 | } |
| | 459 | } |
| | 460 | } |
| | 461 | |
| | 462 | opendir(DIR,"$Conf::dbdir/installed"); |
| | 463 | my @files = readdir(DIR); |
| | 464 | closedir(DIR); |
| | 465 | foreach $file (@files) { |
| | 466 | next if ( $file eq "." ); |
| | 467 | next if ( $file eq ".." ); |
| | 468 | next if ( $file =~ /^old/ ); |
| | 469 | %metadata = parsemetafile("$Conf::dbdir/installed/$file"); |
| | 470 | |
| | 471 | foreach $prog (@db) { |
| | 472 | @templine = split(/\;/,$prog); |
| | 473 | if (("$metadata{'Name'}" eq "$templine[0]") && ("$metadata{'Release'}" < "$templine[2]" && "$forweb" ne "notice")) { |
| | 474 | push(@updatepaks,$metadata{'Name'}); |
| | 475 | if ("$forweb" eq "forweb") { |
| | 476 | print "<option value=\"$metadata{'Name'}\">Update: $metadata{'Name'} -- Version: $metadata{'ProgVersion'} -> $templine[1] -- Release: $metadata{'Release'} -> $templine[2]</option>\n"; |
| | 477 | } else { |
| | 478 | my $command = "Update: $metadata{'Name'}\nVersion: $metadata{'ProgVersion'} -> $templine[1]\nRelease: $metadata{'Release'} -> $templine[2]\n"; |
| | 479 | if ("$Pakfire::enable_colors" eq "1") { |
| | 480 | print "$color{'lila'}$command$color{'normal'}\n"; |
| | 481 | } else { |
| | 482 | print "$command\n"; |
| | 483 | } |
| | 484 | } |
| | 485 | } |
| | 486 | } |
| | 487 | } |
| | 488 | return @updatepaks; |
| | 489 | } else { |
| | 490 | my $line; |
| | 491 | my $use_color; |
| | 492 | my @templine; |
| | 493 | my $count; |
| | 494 | foreach $line (sort @db) { |
| | 495 | next unless ($line =~ /.*;.*;.*;/ ); |
| | 496 | $use_color = ""; |
| | 497 | @templine = split(/\;/,$line); |
| | 498 | if ("$filter" eq "notinstalled") { |
| | 499 | next if ( -e "$Conf::dbdir/installed/meta-$templine[0]" ); |
| | 500 | } elsif ("$filter" eq "installed") { |
| | 501 | next unless ( -e "$Conf::dbdir/installed/meta-$templine[0]" ); |
| | 502 | } |
| | 503 | $count++; |
| | 504 | if ("$forweb" eq "forweb") |
| | 505 | { |
| | 506 | if ("$filter" eq "notinstalled") { |
| | 507 | print "<option value=\"$templine[0]\">$templine[0]-$templine[1]-$templine[2]</option>\n"; |
| | 508 | } else { |
| | 509 | print "<option value=\"$templine[0]\">$templine[0]</option>\n"; |
| | 510 | } |
| | 511 | } else { |
| | 512 | if ("$Pakfire::enable_colors" eq "1") { |
| | 513 | if (&isinstalled("$templine[0]")) { |
| | 514 | $use_color = "$color{'red'}" |
| | 515 | } else { |
| | 516 | $use_color = "$color{'green'}" |
| | 517 | } |
| | 518 | } |
| | 519 | print "${use_color}Name: $templine[0]\nProgVersion: $templine[1]\nRelease: $templine[2]$color{'normal'}\n\n"; |
| | 520 | } |
| | 521 | } |
| | 522 | print "$count packages total.\n" unless ("$forweb" eq "forweb"); |
| | 523 | } |
| | 524 | } |
| | 525 | |
| | 526 | sub resolvedeps_one { |
| | 527 | my $pak = shift; |
| | 528 | |
| | 529 | getmetafile("$pak"); |
| | 530 | |
| | 531 | message("PAKFIRE RESV: $pak: Resolving dependencies..."); |
| | 532 | |
| | 533 | my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak"); |
| | 534 | my @all; |
| | 535 | my @deps = split(/ /, $metadata{'Dependencies'}); |
| | 536 | chomp (@deps); |
| | 537 | foreach (@deps) { |
| | 538 | if ($_) { |
| | 539 | my $return = &isinstalled($_); |
| | 540 | if ($return eq 0) { |
| | 541 | message("PAKFIRE RESV: $pak: Dependency is already installed: $_"); |
| | 542 | } else { |
| | 543 | message("PAKFIRE RESV: $pak: Need to install dependency: $_"); |
| | 544 | push(@all,$_); |
| | 545 | } |
| | 546 | } |
| | 547 | } |
| | 548 | |
| | 549 | return @all; |
| | 550 | } |
| | 551 | |
| | 552 | sub resolvedeps { |
| | 553 | my $pak = shift; |
| | 554 | my @all; |
| | 555 | |
| | 556 | # Resolve all not yet installed dependencies of $pak |
| | 557 | my @deps = &resolvedeps_one($pak); |
| | 558 | push(@all, @deps); |
| | 559 | |
| | 560 | # For each dependency, we check if more dependencies exist |
| | 561 | while (@deps) { |
| | 562 | my $dep = pop(@deps); |
| | 563 | |
| | 564 | my @subdeps = &resolvedeps_one($dep); |
| | 565 | foreach my $subdep (@subdeps) { |
| | 566 | # Skip the package we are currently resolving for |
| | 567 | next if ($pak eq $subdep); |
| | 568 | |
| | 569 | # If the package is not already to be installed, |
| | 570 | # we add it to the list (@all) and check if it has |
| | 571 | # more dependencies on its own. |
| | 572 | unless (grep {$_ eq $subdep} @all) { |
| | 573 | push(@deps, $subdep); |
| | 574 | push(@all, $subdep); |
| | 575 | } |
| | 576 | } |
| | 577 | } |
| | 578 | |
| | 579 | return @all; |
| | 580 | } |
| | 581 | |
| | 582 | sub resolvedeps_recursive { |
| | 583 | my @packages = @_; |
| | 584 | my @result = (); |
| | 585 | |
| | 586 | foreach my $pkg (@packages) { |
| | 587 | my @deps = &Pakfire::resolvedeps($pkg); |
| | 588 | |
| | 589 | foreach my $dep (@deps) { |
| | 590 | push(@result, $dep); |
| | 591 | } |
| | 592 | } |
| | 593 | |
| | 594 | # Sort the result array and remove dupes |
| | 595 | my %sort = map{ $_, 1 } @result; |
| | 596 | @result = keys %sort; |
| | 597 | |
| | 598 | return @result; |
| | 599 | } |
| | 600 | |
| | 601 | sub cleanup { |
| | 602 | my $dir = shift; |
| | 603 | my $path; |
| | 604 | |
| | 605 | logger("CLEANUP: $dir"); |
| | 606 | |
| | 607 | if ( "$dir" eq "meta" ) { |
| | 608 | $path = "$Conf::dbdir/meta"; |
| | 609 | } elsif ( "$dir" eq "tmp" ) { |
| | 610 | $path = "$Conf::tmpdir"; |
| | 611 | } |
| | 612 | chdir("$path"); |
| | 613 | opendir(DIR,"."); |
| | 614 | my @files = readdir(DIR); |
| | 615 | closedir(DIR); |
| | 616 | foreach (@files) { |
| | 617 | unless (($_ eq ".") || ($_ eq "..")) { |
| | 618 | system("rm -rf $_"); |
| | 619 | } |
| | 620 | } |
| | 621 | } |
| | 622 | |
| | 623 | sub getmetafile { |
| | 624 | my $pak = shift; |
| | 625 | |
| | 626 | unless ( -e "$Conf::dbdir/meta/meta-$pak" ) { |
| | 627 | fetchfile("meta/meta-$pak", ""); |
| | 628 | move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak"); |
| | 629 | } |
| | 630 | |
| | 631 | if ( -z "$Conf::dbdir/meta/meta-$pak" ) { |
| | 632 | fetchfile("meta/meta-$pak", ""); |
| | 633 | move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak"); |
| | 634 | } |
| | 635 | |
| | 636 | open(FILE, "<$Conf::dbdir/meta/meta-$pak"); |
| | 637 | my @line = <FILE>; |
| | 638 | close(FILE); |
| | 639 | |
| | 640 | open(FILE, ">$Conf::dbdir/meta/meta-$pak"); |
| | 641 | foreach (@line) { |
| | 642 | my $string = $_; |
| | 643 | $string =~ s/\r\n/\n/g; |
| | 644 | print FILE $string; |
| | 645 | } |
| | 646 | close(FILE); |
| | 647 | return 1; |
| | 648 | } |
| | 649 | |
| | 650 | sub getsize { |
| | 651 | my $pak = shift; |
| | 652 | |
| | 653 | getmetafile("$pak"); |
| | 654 | |
| | 655 | if (my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak")) { |
| | 656 | return $metadata{'Size'}; |
| | 657 | } |
| | 658 | return 0; |
| | 659 | } |
| | 660 | |
| | 661 | sub parsemetafile { |
| | 662 | ### This subroutine returns a hash with the contents of a meta- file |
| | 663 | # Pass path to metafile as argument: Pakfire::parsemetafile("$Conf::dbdir/meta/meta-$pak") |
| | 664 | # Usage is always with an argument. |
| | 665 | my $metafile = shift; |
| | 666 | |
| | 667 | my %metadata = (); |
| | 668 | |
| | 669 | my @templine; |
| | 670 | my @file; |
| | 671 | |
| | 672 | if (! -e $metafile ) { |
| | 673 | return 0; |
| | 674 | } |
| | 675 | |
| | 676 | open(FILE, "<$metafile"); |
| | 677 | @file = <FILE>; |
| | 678 | close(FILE); |
| | 679 | |
| | 680 | foreach (@file) { |
| | 681 | @templine = split(/\: /,$_); |
| | 682 | if ($templine[1]) { |
| | 683 | chomp($templine[1]); |
| | 684 | $metadata{"$templine[0]"} = $templine[1]; |
| | 685 | } |
| | 686 | } |
| | 687 | |
| | 688 | return %metadata; |
| | 689 | } |
| | 690 | |
| | 691 | sub decryptpak { |
| | 692 | my $pak = shift; |
| | 693 | |
| | 694 | cleanup("tmp"); |
| | 695 | |
| | 696 | my $file = getpak("$pak", "noforce"); |
| | 697 | |
| | 698 | logger("DECRYPT STARTED: $pak"); |
| | 699 | my $return = system("cd $Conf::tmpdir/ && gpg -d --batch --quiet --no-verbose --status-fd 2 --output - < $Conf::cachedir/$file 2>/dev/null | tar x"); |
| | 700 | $return %= 255; |
| | 701 | logger("DECRYPT FINISHED: $pak - Status: $return"); |
| | 702 | if ($return != 0) { exit 1; } |
| | 703 | } |
| | 704 | |
| | 705 | sub getpak { |
| | 706 | my $pak = shift; |
| | 707 | my $force = shift; |
| | 708 | |
| | 709 | getmetafile("$pak"); |
| | 710 | |
| | 711 | my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak"); |
| | 712 | my $file = $metadata{'File'}; |
| | 713 | |
| | 714 | unless ($file) { |
| | 715 | message("No filename given in meta-file."); |
| | 716 | exit 1; |
| | 717 | } |
| | 718 | |
| | 719 | unless ( "$force" eq "force" ) { |
| | 720 | if ( -e "$Conf::cachedir/$file" ) { |
| | 721 | return $file; |
| | 722 | } |
| | 723 | } |
| | 724 | |
| | 725 | fetchfile("paks/$file", ""); |
| | 726 | return $file; |
| | 727 | } |
| | 728 | |
| | 729 | sub setuppak { |
| | 730 | my $pak = shift; |
| | 731 | |
| | 732 | message("PAKFIRE INST: $pak: Decrypting..."); |
| | 733 | decryptpak("$pak"); |
| | 734 | |
| | 735 | message("PAKFIRE INST: $pak: Copying files and running post-installation scripts..."); |
| | 736 | my $return = system("cd $Conf::tmpdir && NAME=$pak ./install.sh >> $Conf::logdir/install-$pak.log 2>&1"); |
| | 737 | $return %= 255; |
| | 738 | if ($return == 0) { |
| | 739 | move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak"); |
| | 740 | cleanup("tmp"); |
| | 741 | copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/"); |
| | 742 | message("PAKFIRE INST: $pak: Finished."); |
| | 743 | message(""); |
| | 744 | } else { |
| | 745 | message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem."); |
| | 746 | exit $return; |
| | 747 | } |
| | 748 | return $return; |
| | 749 | } |
| | 750 | |
| | 751 | sub upgradecore { |
| | 752 | getcoredb("noforce"); |
| | 753 | eval(`grep "core_" $Conf::dbdir/lists/core-list.db`); |
| | 754 | if ("$core_release" > "$Conf::core_mine") { |
| | 755 | # Safety check for lazy testers: |
| | 756 | # Before we upgrade to the latest release, we re-install the previous release |
| | 757 | # to make sure that the tester has always been on the latest version. |
| | 758 | my $tree = &get_tree(); |
| | 759 | $Conf::core_mine-- if ($tree eq "testing" || $tree eq "unstable"); |
| | 760 | |
| | 761 | message("CORE UPGR: Upgrading from release $Conf::core_mine to $core_release"); |
| | 762 | |
| | 763 | my @seq = `seq $Conf::core_mine $core_release`; |
| | 764 | shift @seq; |
| | 765 | my $release; |
| | 766 | foreach $release (@seq) { |
| | 767 | chomp($release); |
| | 768 | getpak("core-upgrade-$release"); |
| | 769 | } |
| | 770 | |
| | 771 | foreach $release (@seq) { |
| | 772 | chomp($release); |
| | 773 | upgradepak("core-upgrade-$release"); |
| | 774 | } |
| | 775 | |
| | 776 | system("echo $core_release > $Conf::coredir/mine"); |
| | 777 | |
| | 778 | } else { |
| | 779 | message("CORE ERROR: No new upgrades available. You are on release $Conf::core_mine."); |
| | 780 | } |
| | 781 | } |
| | 782 | |
| | 783 | sub isinstalled { |
| | 784 | my $pak = shift; |
| | 785 | if ( open(FILE,"<$Conf::dbdir/installed/meta-$pak") ) { |
| | 786 | close(FILE); |
| | 787 | return 0; |
| | 788 | } else { |
| | 789 | return 1; |
| | 790 | } |
| | 791 | } |
| | 792 | |
| | 793 | sub upgradepak { |
| | 794 | my $pak = shift; |
| | 795 | |
| | 796 | message("PAKFIRE UPGR: $pak: Decrypting..."); |
| | 797 | decryptpak("$pak"); |
| | 798 | |
| | 799 | message("PAKFIRE UPGR: $pak: Upgrading files and running post-upgrading scripts..."); |
| | 800 | my $return = system("cd $Conf::tmpdir && NAME=$pak ./update.sh >> $Conf::logdir/update-$pak.log 2>&1"); |
| | 801 | $return %= 255; |
| | 802 | if ($return == 0) { |
| | 803 | move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak"); |
| | 804 | cleanup("tmp"); |
| | 805 | copy("$Conf::dbdir/meta/meta-$pak", "$Conf::dbdir/installed/"); |
| | 806 | message("PAKFIRE UPGR: $pak: Finished."); |
| | 807 | message(""); |
| | 808 | } else { |
| | 809 | message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem."); |
| | 810 | exit $return; |
| | 811 | } |
| | 812 | return $return; |
| | 813 | } |
| | 814 | |
| | 815 | sub removepak { |
| | 816 | my $pak = shift; |
| | 817 | |
| | 818 | message("PAKFIRE REMV: $pak: Decrypting..."); |
| | 819 | decryptpak("$pak"); |
| | 820 | |
| | 821 | message("PAKFIRE REMV: $pak: Removing files and running post-removing scripts..."); |
| | 822 | my $return = system("cd $Conf::tmpdir && NAME=$pak ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1"); |
| | 823 | $return %= 255; |
| | 824 | if ($return == 0) { |
| | 825 | unlink("$Conf::dbdir/rootfiles/$pak"); |
| | 826 | unlink("$Conf::dbdir/installed/meta-$pak"); |
| | 827 | cleanup("tmp"); |
| | 828 | message("PAKFIRE REMV: $pak: Finished."); |
| | 829 | message(""); |
| | 830 | } else { |
| | 831 | message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem."); |
| | 832 | exit $return; |
| | 833 | } |
| | 834 | return $return; |
| | 835 | } |
| | 836 | |
| | 837 | sub beautifysize { |
| | 838 | my $size = shift; |
| | 839 | #$size = $size / 1024; |
| | 840 | my $unit; |
| | 841 | |
| | 842 | if ($size > 1023*1024) { |
| | 843 | $size = ($size / (1024*1024)); |
| | 844 | $unit = "MB"; |
| | 845 | } elsif ($size > 1023) { |
| | 846 | $size = ($size / 1024); |
| | 847 | $unit = "KB"; |
| | 848 | } else { |
| | 849 | $unit = "B"; |
| | 850 | } |
| | 851 | $size = sprintf("%.2f" , $size); |
| | 852 | my $string = "$size $unit"; |
| | 853 | return $string; |
| | 854 | } |
| | 855 | |
| | 856 | sub makeuuid { |
| | 857 | unless ( -e "$Conf::dbdir/uuid" ) { |
| | 858 | open(FILE, "</proc/sys/kernel/random/uuid"); |
| | 859 | my @line = <FILE>; |
| | 860 | close(FILE); |
| | 861 | |
| | 862 | open(FILE, ">$Conf::dbdir/uuid"); |
| | 863 | foreach (@line) { |
| | 864 | print FILE $_; |
| | 865 | } |
| | 866 | close(FILE); |
| | 867 | } |
| | 868 | } |
| | 869 | |
| | 870 | sub callback { |
| | 871 | my ($data, $response, $protocol) = @_; |
| | 872 | $final_data .= $data; |
| | 873 | print progress_bar( length($final_data), $total_size, 30, '=' ); |
| | 874 | } |
| | 875 | |
| | 876 | sub progress_bar { |
| | 877 | my ( $got, $total, $width, $char ) = @_; |
| | 878 | my $show_bfile; |
| | 879 | $width ||= 30; $char ||= '='; |
| | 880 | my $len_bfile = length $bfile; |
| | 881 | if ("$len_bfile" >= "17") { |
| | 882 | $show_bfile = substr($bfile,0,17)."..."; |
| | 883 | } else { |
| | 884 | $show_bfile = $bfile; |
| | 885 | } |
| | 886 | $progress = sprintf("%.2f%%", 100*$got/+$total); |
| | 887 | sprintf "$color{'lightgreen'}%-20s %7s |%-${width}s| %10s$color{'normal'}\r",$show_bfile, $progress, $char x (($width-1)*$got/$total). '>', beautifysize($got); |
| | 888 | } |
| | 889 | |
| | 890 | sub updates_available { |
| | 891 | # Get packets with updates available |
| | 892 | my @upgradepaks = &Pakfire::dblist("upgrade", "noweb"); |
| | 893 | |
| | 894 | # Get the length of the returned array |
| | 895 | my $updatecount = scalar @upgradepaks; |
| | 896 | |
| | 897 | return "$updatecount"; |
| | 898 | } |
| | 899 | |
| | 900 | sub coreupdate_available { |
| | 901 | eval(`grep "core_" $Conf::dbdir/lists/core-list.db`); |
| | 902 | if ("$core_release" > "$Conf::core_mine") { |
| | 903 | return "yes ($core_release)"; |
| | 904 | } |
| | 905 | else { |
| | 906 | return "no"; |
| | 907 | } |
| | 908 | } |
| | 909 | |
| | 910 | sub reboot_required { |
| | 911 | if ( -e "/var/run/need_reboot" ) { |
| | 912 | return "yes"; |
| | 913 | } |
| | 914 | else { |
| | 915 | return "no"; |
| | 916 | } |
| | 917 | } |
| | 918 | |
| | 919 | sub status { |
| | 920 | # General info |
| | 921 | my $return = "Core-Version: $Conf::version\n"; |
| | 922 | $return .= "Core-Update-Level: $Conf::core_mine\n"; |
| | 923 | $return .= "Last update: " . &General::age("/opt/pakfire/db/core/mine") . " ago\n"; |
| | 924 | $return .= "Last core-list update: " . &General::age("/opt/pakfire/db/lists/core-list.db") . " ago\n"; |
| | 925 | $return .= "Last server-list update: " . &General::age("/opt/pakfire/db/lists/server-list.db") . " ago\n"; |
| | 926 | $return .= "Last packages-list update: " . &General::age("/opt/pakfire/db/lists/packages_list.db") . " ago\n"; |
| | 927 | |
| | 928 | # Get availability of core updates |
| | 929 | $return .= "Core-Update available: " . &Pakfire::coreupdate_available() . "\n"; |
| | 930 | |
| | 931 | # Get availability of package updates |
| | 932 | $return .= "Package-Updates available: " . &Pakfire::updates_available() . "\n"; |
| | 933 | |
| | 934 | # Test if reboot is required |
| | 935 | $return .= "Reboot required: " . &Pakfire::reboot_required() . "\n"; |
| | 936 | |
| | 937 | # Return status text |
| | 938 | print "$return"; |
| | 939 | exit 1; |
| | 940 | } |
| | 941 | |
| | 942 | sub get_arch() { |
| | 943 | # Append architecture |
| | 944 | my ($sysname, $nodename, $release, $version, $machine) = POSIX::uname(); |
| | 945 | |
| | 946 | # We only support armv6l for 32 bit arm |
| | 947 | if ($machine =~ m/armv[67]/) { |
| | 948 | return "armv6l"; |
| | 949 | } |
| | 950 | |
| | 951 | return $machine; |
| | 952 | } |
| | 953 | |
| | 954 | sub get_tree() { |
| | 955 | # Return stable if nothing is set |
| | 956 | return "stable" unless (defined $pakfiresettings{'TREE'}); |
| | 957 | |
| | 958 | return $pakfiresettings{'TREE'}; |
| | 959 | } |
| | 960 | |
| | 961 | sub make_version() { |
| | 962 | my $version = ""; |
| | 963 | |
| | 964 | # Open /etc/system-release |
| | 965 | open(RELEASE, "</etc/system-release"); |
| | 966 | my $release = <RELEASE>; |
| | 967 | close(RELEASE); |
| | 968 | |
| | 969 | # Add the main relase |
| | 970 | if ($release =~ m/IPFire ([\d\.]+)/) { |
| | 971 | $version .= $1; |
| | 972 | } |
| | 973 | |
| | 974 | # Append suffix for tree |
| | 975 | my $tree = &get_tree(); |
| | 976 | if ($tree eq "testing") { |
| | 977 | $version .= ".1"; |
| | 978 | } elsif ($tree eq "unstable") { |
| | 979 | $version .= ".2"; |
| | 980 | } |
| | 981 | |
| | 982 | # Append architecture |
| | 983 | $version .= "-" . &get_arch(); |
| | 984 | |
| | 985 | return $version; |
| | 986 | } |
| | 987 | |
| | 988 | 1; |
projects / people / pmueller / ipfire-2.x.git / blame_incremental