1#!/usr/bin/perl -w -T 2 3# <@LICENSE> 4# Licensed to the Apache Software Foundation (ASF) under one or more 5# contributor license agreements. See the NOTICE file distributed with 6# this work for additional information regarding copyright ownership. 7# The ASF licenses this file to you under the Apache License, Version 2.0 8# (the "License"); you may not use this file except in compliance with 9# the License. You may obtain a copy of the License at: 10# 11# http://www.apache.org/licenses/LICENSE-2.0 12# 13# Unless required by applicable law or agreed to in writing, software 14# distributed under the License is distributed on an "AS IS" BASIS, 15# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16# See the License for the specific language governing permissions and 17# limitations under the License. 18# </@LICENSE> 19 20use strict; 21use warnings; 22use re 'taint'; 23 24my $VERSION = 'svnunknown'; 25if ('$Id$' =~ ':') { 26 # Subversion keyword "$Id$" has been successfully expanded. 27 # Doesn't happen with automated launchpad builds: 28 # https://bugs.launchpad.net/launchpad/+bug/780916 29 $VERSION = &Mail::SpamAssassin::Version . ' / svn' . (split(/\s+/, '$Id$'))[2]; 30} 31 32my $PREFIX = '@@PREFIX@@'; # substituted at 'make' time 33my $DEF_RULES_DIR = '@@DEF_RULES_DIR@@'; # substituted at 'make' time 34my $LOCAL_RULES_DIR = '@@LOCAL_RULES_DIR@@'; # substituted at 'make' time 35my $LOCAL_STATE_DIR = '@@LOCAL_STATE_DIR@@'; # substituted at 'make' time 36use lib '@@INSTALLSITELIB@@'; # substituted at 'make' time 37 38# We want to do a small amount of macro processing during channel installs, 39# based on the values as passed in via 'make' 40my %MACRO_VALUES = ( 41 'VERSION' => '@@VERSION@@', 42 'CONTACT_ADDRESS' => '@@CONTACT_ADDRESS@@', 43 'PREFIX' => '@@PREFIX@@', 44 'DEF_RULES_DIR' => '@@DEF_RULES_DIR@@', 45 'LOCAL_RULES_DIR' => '@@LOCAL_RULES_DIR@@', 46 'LOCAL_STATE_DIR' => '@@LOCAL_STATE_DIR@@', 47 'INSTALLSITELIB' => '@@INSTALLSITELIB@@', 48); 49 50# Standard perl modules 51use Errno qw(ENOENT EACCES); 52use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_CREAT O_EXCL); 53use File::Spec; 54use File::Path; 55use Getopt::Long; 56use Pod::Usage; 57use Config; 58use POSIX qw(locale_h setsid sigprocmask _exit); 59 60POSIX::setlocale(LC_TIME,'C'); 61 62BEGIN { # see comments in "spamassassin.raw" for doco 63 my @bin = File::Spec->splitpath($0); 64 my $bin = ($bin[0] ? File::Spec->catpath(@bin[0..1], '') : $bin[1]) 65 || File::Spec->curdir; 66 67 if (-e $bin.'/lib/Mail/SpamAssassin.pm' 68 || !-e '@@INSTALLSITELIB@@/Mail/SpamAssassin.pm' ) 69 { 70 my $searchrelative; 71 $searchrelative = 1; # disabled during "make install": REMOVEFORINST 72 if ($searchrelative && $bin eq '../' && -e '../blib/lib/Mail/SpamAssassin.pm') 73 { 74 unshift ( @INC, '../blib/lib' ); 75 } else { 76 foreach ( qw(lib ../lib/site_perl 77 ../lib/spamassassin ../share/spamassassin/lib)) 78 { 79 my $dir = File::Spec->catdir( $bin, split ( '/', $_ ) ); 80 if ( -f File::Spec->catfile( $dir, "Mail", "SpamAssassin.pm" ) ) 81 { unshift ( @INC, $dir ); last; } 82 } 83 } 84 } 85} 86 87# These are the non-standard required modules 88use Net::DNS; 89use HTTP::Date qw(time2str); 90use Archive::Tar 1.23; 91use IO::Zlib 1.04; 92use Mail::SpamAssassin::Logger qw(:DEFAULT info log_message); 93 94our ($have_lwp, $io_socket_module_name, $have_inet4, $use_inet4, $have_inet6, $use_inet6, $have_sha256, $have_sha512); 95 96BEGIN { 97 # Deal with optional modules 98 99 eval { require Digest::SHA; Digest::SHA->import(qw(sha256_hex sha512_hex)); 1 } and do { $have_sha256=1; $have_sha512=1 } 100 or die "Unable to verify file hashes! You must install a modern version of Digest::SHA."; 101 102 $have_lwp = eval { 103 require LWP::UserAgent; 104 }; 105 106 if (eval { require IO::Socket::IP }) { # handles IPv6 and IPv4 107 $io_socket_module_name = 'IO::Socket::IP'; 108 } elsif (eval { require IO::Socket::INET6 }) { # handles IPv6 and IPv4 109 $io_socket_module_name = 'IO::Socket::INET6'; 110 111 } elsif (eval { require IO::Socket::INET }) { # IPv4 only 112 $io_socket_module_name = 'IO::Socket::INET'; 113 } 114 115 $have_inet4 = # can we create a PF_INET socket? 116 defined $io_socket_module_name && eval { 117 my $sock = 118 $io_socket_module_name->new(LocalAddr => '0.0.0.0', Proto => 'tcp'); 119 $sock->close or die "error closing socket: $!" if $sock; 120 $sock ? 1 : undef; 121 }; 122 123 $have_inet6 = # can we create a PF_INET6 socket? 124 defined $io_socket_module_name && 125 $io_socket_module_name ne 'IO::Socket::INET' && 126 eval { 127 my $sock = 128 $io_socket_module_name->new(LocalAddr => '::', Proto => 'tcp'); 129 $sock->close or die "error closing socket: $!" if $sock; 130 $sock ? 1 : undef; 131 }; 132} 133 134# These should already be available 135use Mail::SpamAssassin; 136use Mail::SpamAssassin::Util qw(untaint_var untaint_file_path 137 proc_status_ok exit_status_str am_running_on_windows 138 secure_tmpfile secure_tmpdir); 139 140# Make the main dbg() accessible in our package w/o an extra function 141*dbg=\&Mail::SpamAssassin::dbg; 142sub dbg; 143 144 145$| = 1; # autoflushing STDOUT makes verbose output consistent with warnings 146 147# Clean up PATH appropriately 148Mail::SpamAssassin::Util::clean_path_in_taint_mode(); 149 150############################################################################## 151 152# Default list of GPG keys allowed to sign update releases 153# 154# pub 4096R/5244EC45 2005-12-20 155# Key fingerprint = 5E54 1DC9 59CB 8BAC 7C78 DFDC 4056 A61A 5244 EC45 156# uid updates.spamassassin.org Signing Key <release@spamassassin.org> 157# sub 4096R/24F434CE 2005-12-20 158# 159# note for gpg newbs: these are "long" gpg keyids. It's common to also 160# use the last 8 hex digits as a shorter keyid string. 161# 162my %valid_GPG = ( 163 '0C2B1D7175B852C64B3CDC716C55397824F434CE' => 1, 164 '5E541DC959CB8BAC7C78DFDC4056A61A5244EC45' => 1, 165); 166 167# Default list of channels to update against 168# 169my @channels = ( 'updates.spamassassin.org' ); 170 171my $IGNORE_MIRBY_OLDER_THAN = (24 * 60 * 60 * 7); # 1 week 172 173############################################################################## 174 175my %opt; 176@{$opt{'gpgkey'}} = (); 177@{$opt{'channel'}} = (); 178my $GPG_ENABLED = 1; 179 180$opt{'gpghomedir'} = File::Spec->catfile($LOCAL_RULES_DIR, 'sa-update-keys'); 181 182Getopt::Long::Configure( 183 qw(bundling no_getopt_compat no_auto_abbrev no_ignore_case)); 184GetOptions( 185 'debug|D:s' => \$opt{'debug'}, 186 'version|V' => \$opt{'version'}, 187 'help|h|?' => \$opt{'help'}, 188 'verbose|v+' => \$opt{'verbose'}, 189 'checkonly' => \$opt{'checkonly'}, 190 'allowplugins' => \$opt{'allowplugins'}, 191 'reallyallowplugins' => \$opt{'reallyallowplugins'}, 192 'refreshmirrors' => \$opt{'refreshmirrors'}, 193 'forcemirror=s' => \$opt{'forcemirror'}, 194 'httputil=s' => \$opt{'httputil'}, 195 'score-multiplier=s' => \$opt{'score-multiplier'}, 196 'score-limit=s' => \$opt{'score-limit'}, 197 198 # allow multiple of these on the commandline 199 'gpgkey=s' => $opt{'gpgkey'}, 200 'gpghomedir=s' => \$opt{'gpghomedir'}, 201 'channel=s' => $opt{'channel'}, 202 203 'install=s' => \$opt{'install'}, 204 'import=s' => \$opt{'import'}, 205 'gpgkeyfile=s' => \$opt{'gpgkeyfile'}, 206 'channelfile=s' => \$opt{'channelfile'}, 207 'updatedir=s' => \$opt{'updatedir'}, 208 'gpg!' => \$GPG_ENABLED, 209 210 '4' => sub { $opt{'force_pf'} = 'inet' }, 211 '6' => sub { $opt{'force_pf'} = 'inet6' }, 212 213 # backward compatibility 214 'usegpg' => \$GPG_ENABLED, 215 216) or print_usage_and_exit(); 217 218if ( defined $opt{'help'} ) { 219 print_usage_and_exit("For more information read the sa-update man page.\n", 0); 220} 221if ( defined $opt{'version'} ) { 222 print_version(); 223 exit(0); 224} 225 226if ( $opt{'allowplugins'} && !$opt{'reallyallowplugins'} ) { 227 warn "Security warning: dangerous option --allowplugins used:\n". 228 "- there should never be need to use this option, see man sa-update(1)\n". 229 "- specify --reallyallowplugins to allow activating plugins\n"; 230 exit 2; 231} 232 233$use_inet4 = $have_inet4 && ( !$opt{'force_pf'} || $opt{'force_pf'} eq 'inet' ); 234$use_inet6 = $have_inet6 && ( !$opt{'force_pf'} || $opt{'force_pf'} eq 'inet6' ); 235 236if ( $opt{'force_pf'} && $opt{'force_pf'} eq 'inet' && !$have_inet4 ) { 237 warn "Option -4 specified but support for the ". 238 "INET protocol family is not available.\n"; 239} 240if ( $opt{'force_pf'} && $opt{'force_pf'} eq 'inet6' && !$have_inet6 ) { 241 warn "Option -6 specified but support for the ". 242 "INET6 protocol family is not available.\n"; 243} 244 245if ( defined $opt{'httputil'} && $opt{'httputil'} !~ /^(curl|wget|fetch|lwp)$/ ) { 246 warn "Invalid parameter for --httputil, curl|wget|fetch|lwp wanted\n"; 247} 248 249if ( defined $opt{'score-multiplier'} && $opt{'score-multiplier'} !~ /^\d+(?:\.\d+)?$/ ) { 250 die "Invalid parameter for --score-multiplier, integer or float expected.\n"; 251} 252if ( defined $opt{'score-limit'} && $opt{'score-limit'} !~ /^\d+(?:\.\d+)?$/ ) { 253 die "Invalid parameter for --score-limit, integer or float expected.\n"; 254} 255 256# Figure out what version of SpamAssassin we're using, and also figure out the 257# reverse of it for the DNS query. Handle x.yyyzzz as well as x.yz. 258my $SAVersion = $Mail::SpamAssassin::VERSION; 259if ($SAVersion =~ /^(\d+)\.(\d{3})(\d{3})$/) { 260 $SAVersion = join(".", $1+0, $2+0, $3+0); 261} 262elsif ($SAVersion =~ /^(\d)\.(\d)(\d)$/) { 263 $SAVersion = "$1.$2.$3"; 264} 265else { 266 die "fatal: SpamAssassin version number '$SAVersion' is in an unknown format!\n"; 267} 268my $RevSAVersion = join(".", reverse split(/\./, $SAVersion)); 269 270# set debug areas, if any specified (only useful for command-line tools) 271$SAVersion =~ /^(\d+\.\d+)/; 272if ($1+0 > 3.0) { 273 $opt{'debug'} ||= 'all' if (defined $opt{'debug'}); 274} 275else { 276 $opt{'debug'} = defined $opt{'debug'}; 277} 278 279# Find the default site rule directory, also setup debugging and other M::SA bits 280my $SA = Mail::SpamAssassin->new({ 281 debug => $opt{'debug'}, 282 local_tests_only => 1, 283 dont_copy_prefs => 1, 284 285 PREFIX => $PREFIX, 286 DEF_RULES_DIR => $DEF_RULES_DIR, 287 LOCAL_RULES_DIR => $LOCAL_RULES_DIR, 288 LOCAL_STATE_DIR => $LOCAL_STATE_DIR, 289}); 290 291if (defined $opt{'updatedir'}) { 292 $opt{'updatedir'} = untaint_file_path($opt{'updatedir'}); 293} 294else { 295 $opt{'updatedir'} = $SA->sed_path('__local_state_dir__/__version__'); 296} 297 298 299# check only disabled gpg 300# https://issues.apache.org/SpamAssassin/show_bug.cgi?id=5854 301if ( defined $opt{'checkonly'}) { 302 $GPG_ENABLED=0; 303 dbg("gpg: Disabling gpg requirement due to checkonly flag."); 304} 305 306 307dbg("generic: sa-update version $VERSION"); 308dbg("generic: using update directory: $opt{'updatedir'}"); 309 310# doesn't really display useful things for this script, but we do want 311# a module/version listing, etc. sa-update may be used for older versions 312# of SA that don't include this function, so eval around it. 313eval { $SA->debug_diagnostics(); 1; }; 314 315$SA->finish(); 316 317# untaint the command-line args; since the root user supplied these, and 318# we're not a setuid script, we trust them 319foreach my $optkey (keys %opt) { 320 next if ref $opt{$optkey}; 321 untaint_var(\$opt{$optkey}); 322} 323 324############################################################################## 325 326# Deal with gpg-related options 327 328if (@{$opt{'gpgkey'}}) { 329 $GPG_ENABLED = 1; 330 foreach my $key (@{$opt{'gpgkey'}}) { 331 unless (is_valid_gpg_key_id($key)) { 332 dbg("gpg: invalid gpgkey parameter $key"); 333 next; 334 } 335 $key = uc $key; 336 dbg("gpg: adding key id $key"); 337 $valid_GPG{$key} = 1; 338 } 339} 340 341if (defined $opt{'gpgkeyfile'}) { 342 $GPG_ENABLED = 1; 343 open(GPG, $opt{'gpgkeyfile'}) 344 or die "cannot open $opt{'gpgkeyfile'} for reading: $!\n"; 345 346 dbg("gpg: reading in gpgfile ".$opt{'gpgkeyfile'}); 347 while(my $key = <GPG>) { 348 chomp $key; 349 350 $key =~ s/#.*$//; # remove comments 351 $key =~ s/^\s+//; # remove leading whitespace 352 $key =~ s/\s+$//; # remove tailing whitespace 353 next if $key eq ''; # skip empty lines 354 355 unless (is_valid_gpg_key_id($key)) { 356 dbg("gpg: invalid key id $key"); 357 next; 358 } 359 $key = uc $key; 360 dbg("gpg: adding key id $key"); 361 $valid_GPG{$key} = 1; 362 } 363 close(GPG) or die "cannot close $opt{'gpgkeyfile'}: $!"; 364} 365 366# At this point, we need to know where GPG is ... 367my $GPGPath; 368if ($GPG_ENABLED || $opt{'import'}) { 369 # find GPG in the PATH 370 # bug 4958: for *NIX it's "gpg", in Windows it's "gpg.exe" 371 $GPGPath = 'gpg' . $Config{_exe}; 372 dbg("gpg: Searching for '$GPGPath'"); 373 374 if ($GPGPath = Mail::SpamAssassin::Util::find_executable_in_env_path($GPGPath)) { 375 dbg("gpg: found $GPGPath"); 376 377 # bug 5030: if GPGPath has a space, put it in quotes 378 if ($GPGPath =~ / /) { 379 $GPGPath =~ s/"/\\"/g; 380 $GPGPath = qq/"$GPGPath"/; 381 dbg("gpg: path changed to $GPGPath"); 382 } 383 } 384 else { 385 die "error: gpg required but not found! It is not recommended, but you can use \"sa-update\" with the --no-gpg to skip the verification. \n"; 386 } 387 388 # GPG was found, and we've been asked to import a key only 389 if ( $opt{'import'} ) { 390 my $ex = import_gpg_key($opt{'import'}); 391 exit $ex; 392 } 393 394 # does the sa-update keyring exist? if not, import it 395 if(!-f File::Spec->catfile($opt{'gpghomedir'}, "trustdb.gpg")) { 396 import_default_keyring(); 397 # attempt to continue even if this fails, anyway 398 } 399 400 # specify which keys are trusted 401 dbg("gpg: release trusted key id list: ".join(" ", keys %valid_GPG)); 402 403 # convert fingerprint gpg ids to keyids 404 foreach (keys %valid_GPG) { 405 my $id = substr $_, -8; 406 $valid_GPG{$id} = 1; 407 } 408} 409 410############################################################################## 411 412# Deal with channel-related options 413if (defined $opt{'channel'} && scalar @{$opt{'channel'}} > 0) { 414 @channels = @{$opt{'channel'}}; 415} 416if (defined $opt{'channelfile'}) { 417 open(CHAN, $opt{'channelfile'}) 418 or die "cannot open $opt{'channelfile'} for reading: $!\n"; 419 420 dbg("channel: reading in channelfile ".$opt{'channelfile'}); 421 @channels = (); 422 while(my $chan = <CHAN>) { 423 chomp $chan; 424 425 $chan =~ s/#.*$//; # remove comments 426 $chan =~ s/^\s+//; # remove leading whitespace 427 $chan =~ s/\s+$//; # remove tailing whitespace 428 next if $chan eq ''; # skip empty lines 429 430 $chan = lc $chan; 431 dbg("channel: adding $chan"); 432 push(@channels, $chan); 433 } 434 close(CHAN) or die "cannot close $opt{'channelfile'}: $!"; 435} 436 437# untaint the channel listing 438for(my $ind = 0; $ind < @channels; $ind++) { 439 local($1); # bug 5061: prevent random taint flagging of $1 440 if ($channels[$ind] =~ /^([a-zA-Z0-9._-]+)$/) { 441 untaint_var(\$channels[$ind]); 442 } 443 else { 444 dbg("channel: skipping invalid channel: $channels[$ind]"); 445 splice @channels, $ind, 1; 446 $ind--; # the next element takes the place of the deleted one 447 } 448} 449 450my ($res, $ua); 451 452if ($opt{'install'}) { 453 if (scalar @channels > 1) { 454 die "fatal: --install cannot be used with multiple --channel switches.\n"; 455 } 456 457} else { 458 $res = Net::DNS::Resolver->new(); 459 $res->force_v4(1) if $have_inet4 && 460 $opt{'force_pf'} && $opt{'force_pf'} eq 'inet'; 461} 462 463# Generate a temporary file to put channel content in for later use ... 464my ($content_file, $tfh) = secure_tmpfile(); 465$tfh 466 or die "fatal: could not create temporary channel content file: $!\n"; 467close $tfh 468 or die "cannot close temporary channel content file $content_file: $!"; 469undef $tfh; 470 471my $lint_failures = 0; 472my $channel_failures = 0; 473my $channel_successes = 0; 474 475# Use a temporary directory for all update channels 476my $UPDTmp; 477 478# we only need to lint the site pre files once 479my $site_pre_linted = 0; 480 481# Go ahead and loop through all of the channels 482foreach my $channel (@channels) { 483 dbg("channel: attempting channel $channel"); 484 my %preserve_files; 485 486 # Convert the channel to a nice-for-filesystem version 487 my $nicechannel = $channel; 488 $nicechannel =~ tr/A-Za-z0-9-/_/cs; 489 490 my $UPDDir = File::Spec->catfile($opt{'updatedir'}, $nicechannel); 491 my $CFFile = "$UPDDir.cf"; 492 my $PREFile = "$UPDDir.pre"; 493 494 if (-d $UPDDir) { 495 dbg("channel: using existing directory $UPDDir"); 496 } else { 497 # create the dir, if it doesn't exist 498 dbg("channel: creating directory $UPDDir"); 499 mkpath([$UPDDir], 0, 0777) 500 or die "channel: cannot create channel directory $UPDDir: $!\n"; 501 } 502 dbg("channel: channel cf file $CFFile"); 503 dbg("channel: channel pre file $PREFile"); 504 505 my $instfile; 506 if ($opt{'install'}) { 507 $instfile = $opt{'install'}; 508 dbg("channel: installing from file $instfile"); 509 } 510 511 my($mirby, $mirby_force_reload, $mirby_file_is_ok); 512 my $mirby_path = File::Spec->catfile($UPDDir, "MIRRORED.BY"); 513 514 # try to read metadata from channel.cf file 515 my $currentV = -1; 516 if (!open(CF, $CFFile)) { 517 dbg("channel: error opening file %s: %s", 518 $CFFile, $!) unless $! == ENOENT; 519 } else { 520 while(<CF>) { 521 local($1,$2); 522 last unless /^# UPDATE\s+([A-Za-z]+)\s+(\S+)/; 523 my($type, $value) = (lc $1,$2); 524 525 dbg("channel: metadata $type = $value, from file $CFFile"); 526 527 if ($type eq 'version') { 528 $value =~ /^(\d+)/; 529 $currentV = $1; 530 } 531 } 532 close(CF) or die "cannot close $CFFile: $!"; 533 } 534 535 # obtain a version number which should be installed 536 my $newV; 537 if ($instfile) { 538 # the /.*/ ensures we use the 3-digit string nearest to the end of string, 539 # otherwise we might pick up something from the middle of the directory path 540 local($1); 541 if ($instfile !~ /(?:.*\D|^)(\d{3,})/) { 542 # this is a requirement 543 die "channel: $channel: --install file $instfile does not contain a 3-digit version number!\n"; 544 } 545 $newV = $1; 546 547 if ( defined $opt{'checkonly'} ) { 548 dbg("channel: $channel: --install and --checkonly, claiming update available"); 549 $channel_successes++; 550 next; 551 } 552 553 } else { # not an install file, get the latest version number from network 554 # Setup the channel version DNS query 555 my $DNSQ = "$RevSAVersion.$channel"; 556 557 my $dnsV = join(' ', do_dns_query($DNSQ)); 558 local($1); 559 if (defined $dnsV && $dnsV =~ /^(\d+)/) { 560 $newV = untaint_var($1) if (!defined $newV || $1 > $newV); 561 dbg("dns: $DNSQ => $dnsV, parsed as $1"); 562 } 563 564 # Not getting a response isn't a failure, there may just not be any updates 565 # for this SA version yet. 566 if (!defined $newV) { 567 my @mirs = do_dns_query("mirrors.$channel"); 568 if (defined shift @mirs) { 569 dbg("channel: no updates available, skipping channel"); 570 } else { 571 channel_failed("channel '$channel': no 'mirrors.$channel' record found"); 572 } 573 next; 574 } 575 576 # If this channel hasn't been installed before, or it's out of date, 577 # keep going. Otherwise, skip it. 578 if ($currentV >= $newV) { 579 dbg("channel: current version is $currentV, new version is $newV, ". 580 "skipping channel"); 581 next; 582 } 583 584 print "Update available for channel $channel: $currentV -> $newV\n" if $opt{'verbose'}; 585 586 # If we are only checking for update availability, exit now 587 if ( defined $opt{'checkonly'} ) { 588 dbg("channel: $channel: update available, not downloading ". 589 "in checkonly mode"); 590 $channel_successes++; 591 next; 592 } 593 594 } 595 596 # we need a directory we control that we can use to avoid loading any rules 597 # when we lint the site pre files, we might as well use the channel temp dir 598 dbg("channel: preparing temp directory for new channel"); 599 if (!$UPDTmp) { 600 $UPDTmp = secure_tmpdir(); 601 dbg("channel: created tmp directory $UPDTmp"); 602 } 603 else { 604 dbg("channel: using existing tmp directory $UPDTmp"); 605 if (!clean_update_dir($UPDTmp)) { 606 die "channel: attempt to clean update temp dir failed, aborting"; 607 } 608 } 609 610 # lint the site pre files (that will be used when lint checking the channel) 611 # before downloading the channel update 612 unless ($site_pre_linted) { 613 dbg("generic: lint checking site pre files once before attempting channel updates"); 614 unless (lint_check_dir(File::Spec->catfile($UPDTmp, "doesnotexist"))) { 615 dbg("generic: lint of site pre files failed, cannot continue"); 616 print "Lint of site pre files failed, cannot continue\n" if $opt{'verbose'}; 617 $lint_failures++; 618 last; 619 } 620 dbg("generic: lint check of site pre files succeeded, continuing with channel updates"); 621 $site_pre_linted = 1; 622 } 623 624 my $content; 625 my $SHA512; 626 my $SHA256; 627 my $GPG; 628 629 if ($instfile) { 630 dbg("channel: using --install files $instfile\{,.sha256,.sha512,.asc\}"); 631 $content = read_install_file($instfile); 632 if ( -s "$instfile.sha512" ) { $SHA512 = read_install_file($instfile.".sha512"); } 633 if ( -s "$instfile.sha256" ) { $SHA256 = read_install_file($instfile.".sha256"); } 634 $GPG = read_install_file($instfile.".asc") if $GPG_ENABLED; 635 636 } else { # not an install file, obtain fresh rules from network 637 dbg("channel: protocol family available: %s%s", 638 join(',', $have_inet4 ? 'inet' : (), 639 $have_inet6 ? 'inet6' : ()), 640 $opt{'force_pf'} ? '; force '.$opt{'force_pf'} : '' ); 641 642 # test if the MIRRORED.BY file for this channel exists, 643 # is nonempty, and is reasonably fresh 644 645 my(@mirr_stat_list) = stat($mirby_path); 646 if (!@mirr_stat_list) { 647 if ($! == ENOENT) { 648 dbg("channel: no mirror file %s, will fetch it", $mirby_path); 649 } else { 650 # protection error, misconfiguration, file system error, ... 651 warn "error: error accessing mirrors file $mirby_path: $!\n"; 652 channel_failed("channel '$channel': error accessing mirrors file $mirby_path: $!"); 653 next; 654 } 655 } elsif (-z _) { 656 dbg("channel: file %s is empty, refreshing mirrors file", $mirby_path); 657 $mirby_force_reload = 1; 658 } elsif ($opt{'refreshmirrors'}) { 659 dbg("channel: --refreshmirrors used, forcing mirrors file refresh ". 660 "on channel $channel"); 661 $mirby_force_reload = 1; 662 } elsif (time - $mirr_stat_list[9] > $IGNORE_MIRBY_OLDER_THAN) { 663 dbg("channel: file %s is too old, refreshing mirrors file", $mirby_path); 664 $mirby_file_is_ok = 1; # mirrors file seems fine, but is old 665 $mirby_force_reload = 1; 666 } else { 667 # mirror file $mirby_path exists, is nonempty, and is reasonably fresh 668 $mirby_file_is_ok = 1; 669 } 670 671 if (!$mirby_file_is_ok || $mirby_force_reload) { 672 # fetch a fresh list of mirrors 673 dbg("channel: DNS lookup on mirrors.$channel"); 674 my @mirrors = do_dns_query("mirrors.$channel"); 675 unless (@mirrors) { 676 warn "error: no mirror data available for channel $channel\n"; 677 channel_failed("channel '$channel': MIRRORED.BY file URL was not in DNS"); 678 next; 679 } 680 foreach my $mirror (@mirrors) { 681 my ($result_fname, $http_ok) = 682 http_get($mirror, $UPDDir, $mirby_path, $mirby_force_reload); 683 if (!$http_ok) { 684 dbg("channel: no mirror data available for channel %s from %s", 685 $channel, $mirror); 686 next; 687 } 688 $mirby = read_content($result_fname, 0); 689 if ($mirby) { 690 dbg("channel: MIRRORED.BY file for channel %s retrieved", $channel); 691 $mirby_file_is_ok = 1; 692 $mirby_force_reload = 0; 693 $preserve_files{$mirby_path} = 1; 694 695 # set file creation time to now, otherwise we'll keep refreshing 696 # (N.B.: curl preserves time of a downloaded file) 697 my $now = time; 698 utime($now, $now, $mirby_path) 699 or warn "error: error setting creation time of $mirby_path: $!\n"; 700 701 last; 702 } 703 } 704 if ($mirby_force_reload) { # not refreshed? 705 warn "error: unable to refresh mirrors file for channel $channel, ". 706 "using old file\n"; 707 } 708 } 709 710 if (!$mirby_file_is_ok) { 711 warn "error: no mirror data available for channel $channel\n"; 712 channel_failed("channel '$channel': MIRRORED.BY file contents were missing"); 713 next; 714 } elsif ($mirby) { 715 # file contents already in memory, no need to read it from a file 716 } elsif (!open(MIRBY, $mirby_path)) { 717 warn "error: error opening mirrors file $mirby_path: $!\n"; 718 channel_failed("channel '$channel': error opening mirrors file $mirby_path: $!"); 719 next; 720 } else { 721 dbg("channel: reading MIRRORED.BY file %s", $mirby_path); 722 { local $/ = undef; $mirby = <MIRBY> } 723 close(MIRBY) or die "cannot close $mirby_path: $!"; 724 $preserve_files{$mirby_path} = 1; 725 } 726 727 # Parse the list of mirrors 728 dbg("channel: parsing MIRRORED.BY file for channel %s", $channel); 729 my %mirrors; 730 my @mirrors = split(/^/, $mirby); 731 while(my $mirror = shift @mirrors) { 732 chomp $mirror; 733 if ( defined $opt{'forcemirror'} ) { 734 $mirror = $opt{'forcemirror'}; 735 $mirrors{$mirror}->{"weight"} = 1; 736 dbg("channel: found mirror $mirror (forced)"); 737 last; 738 } 739 740 $mirror =~ s/#.*$//; # remove comments 741 $mirror =~ s/^\s+//; # remove leading whitespace 742 $mirror =~ s/\s+$//; # remove tailing whitespace 743 next if $mirror eq ''; # skip empty lines 744 745 # We only support HTTP (and HTTPS) right now 746 if ($mirror !~ m{^https?://}i) { 747 dbg("channel: skipping non-HTTP mirror: $mirror"); 748 next; 749 } 750 751 dbg("channel: found mirror $mirror"); 752 753 my @data; 754 ($mirror,@data) = split(/\s+/, $mirror); 755 $mirror =~ s{/+\z}{}; # http://example.com/updates/ -> .../updates 756 $mirrors{$mirror}->{weight} = 1; 757 foreach (@data) { 758 my($k,$v) = split(/=/, $_, 2); 759 $mirrors{$mirror}->{$k} = $v; 760 } 761 } 762 763 unless (%mirrors) { 764 warn "error: no mirrors available for channel $channel\n"; 765 channel_failed("channel '$channel': no mirrors available"); 766 next; 767 } 768 769 # Now that we've laid the foundation, go grab the appropriate files 770 # 771 my $path_content = File::Spec->catfile($UPDDir, "$newV.tar.gz"); 772 my $path_sha512 = File::Spec->catfile($UPDDir, "$newV.tar.gz.sha512"); 773 my $path_sha256 = File::Spec->catfile($UPDDir, "$newV.tar.gz.sha256"); 774 my $path_asc = File::Spec->catfile($UPDDir, "$newV.tar.gz.asc"); 775 776 # Loop through all available mirrors, choose from them randomly 777 # if any get fails, choose another mirror to retry _all_ files again 778 # sleep few seconds on retries 779 my $download_ok = 0; 780 while (my $mirror = choose_mirror(\%mirrors)) { 781 my ($result_fname, $http_ok); 782 # Grab the data hash for this mirror, then remove it from the list 783 my $mirror_info = $mirrors{$mirror}; 784 delete $mirrors{$mirror}; 785 786 # Make sure we start without files from existing tries 787 unlink($path_content); 788 unlink($path_sha512); 789 unlink($path_sha256); 790 unlink($path_asc); 791 792 my $sleep_sec = 2; 793 794 if (!check_mirror_af($mirror)) { 795 my @my_af; 796 push(@my_af, "IPv4") if $use_inet4; 797 push(@my_af, "IPv6") if $use_inet6; 798 push(@my_af, "no IP service") if !@my_af; 799 dbg("reject mirror %s: no common address family (%s), %s", 800 $mirror, join(" ", @my_af), 801 %mirrors ? "sleeping $sleep_sec sec and trying next" : 'no mirrors left'); 802 sleep($sleep_sec) if %mirrors; 803 next; 804 } 805 806 dbg("channel: selected mirror $mirror"); 807 808 # Actual archive file 809 ($result_fname, $http_ok) = http_get("$mirror/$newV.tar.gz", $UPDDir); 810 if (!$http_ok || !-s $result_fname) { 811 dbg("channel: failed to get $newV.tar.gz from mirror $mirror, %s", 812 %mirrors ? "sleeping $sleep_sec sec and trying next" : 'no mirrors left'); 813 sleep($sleep_sec) if %mirrors; 814 next; 815 } 816 817 # SHA512 of the archive file 818 ($result_fname, $http_ok) = http_get("$mirror/$newV.tar.gz.sha512", $UPDDir); 819 if (!$http_ok || !-s $result_fname) { 820 # If not found, try SHA256 instead 821 ($result_fname, $http_ok) = http_get("$mirror/$newV.tar.gz.sha256", $UPDDir); 822 if (!$http_ok || !-s $result_fname) { 823 dbg("channel: No sha512 or sha256 file available from $mirror, %s", 824 %mirrors ? "sleeping $sleep_sec sec and trying next" : 'no mirrors left'); 825 sleep($sleep_sec) if %mirrors; 826 next; 827 } 828 } 829 830 # if GPG is enabled, the GPG detached signature of the archive file 831 if ($GPG_ENABLED) { 832 ($result_fname, $http_ok) = http_get("$mirror/$newV.tar.gz.asc", $UPDDir); 833 if (!$http_ok || !-s $result_fname) { 834 dbg("channel: No GPG/asc file available from $mirror, %s", 835 %mirrors ? "sleeping $sleep_sec sec and trying next" : 'no mirrors left'); 836 sleep($sleep_sec) if %mirrors; 837 next; 838 } 839 } 840 841 $download_ok = 1; 842 last; 843 } 844 845 if ($download_ok) { 846 if (-s $path_content) { 847 $content = read_content($path_content, 1); # binary 848 $preserve_files{$path_content} = 1; 849 } 850 if (-s $path_sha512) { 851 $SHA512 = read_content($path_sha512, 0); # ascii 852 $preserve_files{$path_sha512} = 1; 853 } 854 if (-s $path_sha256) { 855 $SHA256 = read_content($path_sha256, 0); # ascii 856 $preserve_files{$path_sha256} = 1; 857 } 858 if (-s $path_asc) { 859 $GPG = read_content($path_asc, 0); # ascii 860 $preserve_files{$path_asc} = 1; 861 } 862 } 863 } 864 865 unless ($content && ( $SHA512 || $SHA256 ) && (!$GPG_ENABLED || $GPG)) { 866 channel_failed("channel '$channel': could not find working mirror"); 867 next; 868 } 869 870 if ( $SHA512 ) { 871 # Validate the SHA512 signature 872 { local($1); 873 $SHA512 =~ /^([a-fA-F0-9]{128})\b/; 874 $SHA512 = defined $1 ? lc($1) : 'INVALID'; 875 } 876 my $digest = sha512_hex($content); 877 dbg("sha512: verification wanted: $SHA512"); 878 dbg("sha512: verification result: $digest"); 879 unless ($digest eq $SHA512) { 880 channel_failed("channel '$channel': SHA512 verification failed"); 881 next; 882 } 883 } 884 885 if ( $SHA256 ) { 886 # Validate the SHA256 signature 887 { local($1); 888 $SHA256 =~ /^([a-fA-F0-9]{64})\b/; 889 $SHA256 = defined $1 ? lc($1) : 'INVALID'; 890 } 891 my $digest = sha256_hex($content); 892 dbg("sha256: verification wanted: $SHA256"); 893 dbg("sha256: verification result: $digest"); 894 unless ($digest eq $SHA256) { 895 channel_failed("channel '$channel': SHA256 verification failed"); 896 next; 897 } 898 } 899 900 # Write the content out to a temp file for GPG/Archive::Tar interaction 901 dbg("channel: populating temp content file %s", $content_file); 902 open(TMP, ">$content_file") 903 or die "fatal: cannot create content temp file $content_file: $!\n"; 904 binmode TMP 905 or die "fatal: cannot set binmode on content temp file $content_file: $!\n"; 906 print TMP $content 907 or die "fatal: cannot write to content temp file $content_file: $!\n"; 908 close TMP 909 or die "fatal: cannot close content temp file $content_file: $!\n"; 910 911 # to sign : gpg -bas file 912 # to verify: gpg --verify --batch --no-tty --status-fd=1 -q --logger-fd=1 file.asc file 913 # look for : [GNUPG:] GOODSIG 6C55397824F434CE updates.spamassassin.org [...] 914 # [GNUPG:] VALIDSIG 0C2B1D7175B852C64B3CDC716C55397824F434CE [...] 915 # [GNUPG:] NO_PUBKEY 6C55397824F434CE 916 if ($GPG) { 917 dbg("gpg: populating temp signature file"); 918 my $sig_file; 919 ($sig_file, $tfh) = secure_tmpfile(); 920 $tfh 921 or die "fatal: couldn't create temp file for GPG signature: $!\n"; 922 binmode $tfh 923 or die "fatal: cannot set binmode on temp file for GPG signature: $!\n"; 924 print $tfh $GPG 925 or die "fatal: cannot write temp file for GPG signature: $!\n"; 926 close $tfh 927 or die "fatal: cannot close temp file for GPG signature: $!\n"; 928 undef $tfh; 929 930 dbg("gpg: calling gpg"); 931 932 my $gpghome = interpolate_gpghomedir(); 933 934 # TODO: we could also use "--keyserver pgp.mit.edu" or similar, 935 # to autodownload missing keys... 936 my $CMD = "$GPGPath $gpghome --verify --batch ". 937 "--no-tty --status-fd=1 -q --logger-fd=1"; 938 939 unless (open(CMD, "$CMD $sig_file $content_file|")) { 940 unlink $sig_file or warn "error: cannot unlink $sig_file: $!\n"; 941 die "fatal: couldn't execute $GPGPath: $!\n"; 942 } 943 944 # Determine the fate of the signature 945 my $signer = ''; 946 my $missingkeys = ''; 947 while(my $GNUPG = <CMD>) { 948 chop $GNUPG; 949 dbg ("gpg: $GNUPG"); 950 951 if ($GNUPG =~ /^gpg: fatal:/) { 952 warn $GNUPG."\n"; # report bad news 953 } 954 955 local($1); 956 if ($GNUPG =~ /^\Q[GNUPG:]\E NO_PUBKEY \S+(\S{8})$/) { 957 $missingkeys .= $1." "; 958 } 959 960 next unless ($GNUPG =~ /^\Q[GNUPG:]\E (?:VALID|GOOD)SIG (\S{8,40})/); 961 my $key = $1; 962 963 # we want either a keyid (8) or a fingerprint (40) 964 if (length $key > 8 && length $key < 40) { 965 substr($key, 8) = ''; 966 } 967 968 # use the longest match we can find 969 $signer = $key if length $key > length $signer; 970 } 971 972 my $errno = 0; close CMD or $errno = $!; 973 proc_status_ok($?,$errno) 974 or warn("gpg: process '$GPGPath' finished: ". 975 exit_status_str($?,$errno)."\n"); 976 977 unlink $sig_file or warn "cannot unlink $sig_file: $!\n"; 978 979 if ($signer) { 980 my $keyid = substr $signer, -8; 981 dbg("gpg: found signature made by key $signer"); 982 if (exists $valid_GPG{$signer}) { 983 dbg("gpg: key id $signer is release trusted"); 984 } 985 elsif (exists $valid_GPG{$keyid}) { 986 dbg("gpg: key id $keyid is release trusted"); 987 } 988 else { 989 dbg("gpg: key id $keyid is not release trusted"); 990 $signer = undef; 991 } 992 } 993 994 unless ($signer) { 995 warn "error: GPG validation failed!\n"; 996 997 if ($missingkeys) { 998 999 warn <<ENDOFVALIDATIONERR; 1000The update downloaded successfully, but it was not signed with a trusted GPG 1001key. Instead, it was signed with the following keys: 1002 1003 $missingkeys 1004 1005Perhaps you need to import the channel's GPG key? For example: 1006 1007 wget https://spamassassin.apache.org/updates/GPG.KEY 1008 sa-update --import GPG.KEY 1009 1010ENDOFVALIDATIONERR 1011 1012 } else { 1013 1014 warn <<ENDOFVALIDATIONERR; 1015The update downloaded successfully, but the GPG signature verification 1016failed. 1017ENDOFVALIDATIONERR 1018 1019 } 1020 1021 channel_failed("channel '$channel': GPG validation failed"); 1022 next; 1023 } 1024 } 1025 1026 # OK, we're all validated at this point, install the new version 1027 dbg("channel: file verification passed, testing update"); 1028 1029 dbg("channel: extracting archive"); 1030 if (!taint_safe_archive_extract($UPDTmp, $content_file)) { 1031 channel_failed("channel '$channel': archive extraction failed"); 1032 next; 1033 } 1034 1035 # check --lint 1036 1037 if (!lint_check_dir($UPDTmp)) { 1038 channel_failed("channel '$channel': lint check of update failed"); 1039 next; 1040 } 1041 1042 dbg("channel: lint check succeeded, extracting archive to $UPDDir..."); 1043 1044 my @totry = ( 1045 { 1046 'try' => sub { 1047 if (-d $UPDDir) { 1048 # ok that worked, too late to stop now! At this stage, if there are 1049 # errors, we have to attempt to carry on regardless, since we've already 1050 # blown away the old ruleset. 1051 dbg("channel: point of no return for existing $UPDDir"); 1052 1053 # clean out the previous channel files, if they exist 1054 if (-f $PREFile && ! unlink $PREFile ) { 1055 warn("channel: attempt to rm channel pre file failed, attempting to continue anyway: $!"); 1056 } 1057 if (-f $CFFile && ! unlink $CFFile ) { 1058 warn("channel: attempt to rm channel cf file failed, attempting to continue anyway: $!"); 1059 } 1060 if (!clean_update_dir($UPDDir, \%preserve_files)) { 1061 warn("channel: attempt to rm channel directory failed, attempting to continue anyway"); 1062 } 1063 } 1064 else { 1065 # create the dir, if it doesn't exist 1066 dbg("channel: creating $UPDDir"); 1067 mkpath([$UPDDir], 0, 0777) 1068 or die "channel: cannot create channel directory $UPDDir: $!\n"; 1069 1070 # ok, that test worked. it's now likely that the .cf's will 1071 # similarly be ok to rename, too. Too late to stop from here on 1072 dbg("channel: point of no return for new $UPDDir"); 1073 } 1074 1075 return 1; 1076 }, 1077 1078 'rollback' => sub { 1079 dbg("channel: attempting to remove the channel and update directories"); 1080 1081 # bug 4941: try to get rid of the empty directories to avoid leaving SA 1082 # with no rules. 1083 rmdir $UPDDir 1084 or dbg("channel: error removing dir %s: %s", $UPDDir, $!); 1085 rmdir $opt{'updatedir'} 1086 or dbg("channel: error removing dir %s: %s", $opt{'updatedir'}, $!); 1087 }, 1088 }, 1089 1090 { 1091 'try' => sub { 1092 # extract the files again for the last time 1093 if (!taint_safe_archive_extract($UPDDir, $content_file)) { 1094 channel_failed("channel '$channel': archive extraction failed"); 1095 return 0; 1096 } 1097 1098 return 1; 1099 }, 1100 1101 'rollback' => sub { 1102 dbg("channel: attempting to clean out the channel update directory"); 1103 1104 # bug 4941: try to get rid of the empty directories to avoid leaving SA 1105 # with no rules. 1106 if (!clean_update_dir($UPDDir, \%preserve_files)) { 1107 warn "channel: attempt to clean up failed extraction also failed!\n"; 1108 } 1109 }, 1110 }, 1111 1112 { 1113 'try' => sub { 1114 if ($instfile) { 1115 dbg("channel: not creating MIRRORED.BY file due to --install"); 1116 return 1; 1117 } 1118 1119 # The $mirby_path file should have already been created by http_get 1120 # and preserved past clean_update_dir() 1121 # 1122 # # Write out the mirby file, not fatal if it doesn't work 1123 # dbg("channel: creating MIRRORED.BY file"); 1124 # open(MBY, ">$mirby_path") 1125 # or die "cannot create a new MIRRORED.BY file: $!\n"; 1126 # print MBY $mirby or die "error writing to $mirby_path: $!"; 1127 # close(MBY) or die "cannot close $mirby_path: $!"; 1128 1129 return 1; 1130 }, 1131 1132 'rollback' => sub { 1133 }, 1134 }, 1135 1136 { 1137 'try' => sub { 1138 # the last step is to create the .cf and .pre files to include the 1139 # channel files 1140 my @CF; 1141 my @PRE; 1142 1143 dbg("channel: creating update cf/pre files"); 1144 1145 # Put in whatever metadata we need 1146 push(@CF, "# UPDATE version $newV\n"); 1147 1148 1149 # Find all of the cf and pre files 1150 opendir(DIR, $UPDDir) 1151 or die "fatal: cannot access $UPDDir: $!\n"; 1152 1153 my @files; 1154 while(my $file = readdir(DIR)) { 1155 next if $file eq '.' || $file eq '..'; 1156 untaint_var(\$file); 1157 my $path = File::Spec->catfile($UPDDir, $file); 1158 next unless (-f $path); # shouldn't ever happen 1159 push(@files, $file); 1160 } 1161 1162 # bug 5371: ensure files are sorted 1163 foreach my $file ( sort @files ) { 1164 if ($file =~ /\.cf$/) { 1165 push(@CF, "include $nicechannel/$file\n"); 1166 } 1167 elsif ($file =~ /\.pre$/) { 1168 push(@PRE, "include $nicechannel/$file\n"); 1169 } 1170 else { 1171 next; 1172 } 1173 1174 dbg("channel: adding $file"); 1175 } 1176 closedir(DIR) or die "cannot close directory $UPDDir: $!"; 1177 1178 # Finally, write out the files to include the update files 1179 if (!write_channel_file($PREFile, \@PRE)) { 1180 channel_failed("channel '$channel': writing of $PREFile failed"); 1181 return 0; 1182 } 1183 if (!write_channel_file($CFFile, \@CF)) { 1184 channel_failed("channel '$channel': writing of $CFFile failed"); 1185 return 0; 1186 } 1187 1188 # if all went fine, remove the .tar.gz, .sha* and .asc files 1189 delete_files( grep(!m{/\QMIRRORED.BY\E\z}, keys %preserve_files) ); 1190 1191 $channel_successes++; 1192 dbg("channel: update complete"); 1193 1194 return 1; 1195 }, 1196 1197 'rollback' => sub { 1198 }, 1199 }, 1200 1201 ); 1202 1203 my $error; 1204 my $eval_stat; 1205 for(my $elem = 0; $elem <= $#totry; $elem++) { 1206 my $success; 1207 eval { 1208 $success = &{$totry[$elem]->{'try'}}(); 1; 1209 } or do { 1210 $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; 1211 }; 1212 if (!$success) { 1213 $error = $elem; 1214 $eval_stat = "step $elem unsuccessful" if !defined $eval_stat; 1215 last; 1216 } 1217 } 1218 if (defined $error) { 1219 dbg("channel: channel failed, attempting rollback: %s", $eval_stat); 1220 for(my $elem = $error; $elem >= 0; $elem--) { 1221 &{$totry[$elem]->{'rollback'}}(); 1222 } 1223 } 1224} 1225 1226############################################################################## 1227 1228# clean out the temp dir 1229if ($UPDTmp) { 1230 dbg("generic: cleaning up temporary directory/files"); 1231 if (!clean_update_dir($UPDTmp)) { 1232 warn "error: unable to clean out the files in $UPDTmp\n"; 1233 } 1234} 1235 1236# clear out the temp files if they still exist 1237foreach ( $content_file, $UPDTmp ) { 1238 next unless defined $_; 1239 my $stat_errn = stat($_) ? 0 : 0+$!; 1240 next if $stat_errn == ENOENT; 1241 1242 if ($stat_errn != 0) { 1243 warn "error: cannot access $_: $!\n"; 1244 } 1245 elsif (-d _) { 1246 rmdir $_ or warn "error: cannot remove directory $_: $!\n"; 1247 } 1248 elsif (-f _) { 1249 unlink $_ or warn "error: cannot remove file $_: $!\n"; 1250 } 1251 else { 1252 warn "error: '$_' isn't a file nor a directory, skipping\n"; 1253 } 1254} 1255 1256my $exit; 1257if ($lint_failures) { 1258 # 2: lint of site pre files failed, cannot continue 1259 $exit = 2; 1260} 1261elsif (!$channel_failures) { 1262 # 0: updates found and successfully applied 1263 # 1: no updates were needed (success with nothing to do) 1264 $exit = $channel_successes ? 0 : 1; 1265} 1266else { # at least some failures 1267 # 3: some failures, but at least one channel succeeded 1268 # 4 or higher means all channels failed 1269 $exit = $channel_successes ? 3 : 4; 1270} 1271 1272dbg("diag: updates complete, exiting with code $exit"); 1273 1274if ($opt{'verbose'}) { 1275 if (!$exit) { 1276 if (defined $opt{'checkonly'}) { 1277 print "Update was available, but not installed in checkonly mode\n"; 1278 } else { 1279 print "Update was available, and was downloaded and installed successfully\n"; 1280 } 1281 } elsif ($exit == 1) { 1282 print "Update finished, no fresh updates were available\n"; 1283 } elsif ($exit == 3) { 1284 print "Update of at least one channel finished, other updates failed\n"; 1285 } else { 1286 print "Update failed, exiting with code $exit\n"; 1287 } 1288} 1289 1290exit $exit; 1291 1292############################################################################## 1293 1294sub read_install_file { 1295 my ($file) = @_; 1296 open (IN, "<$file") or die "cannot open $file\n"; 1297 my $all; 1298 { local $/ = undef; $all = <IN> } 1299 close IN or die "cannot close $file: $!"; 1300 return $all; 1301} 1302 1303############################################################################## 1304 1305sub write_channel_file { 1306 my ($filename, $contents) = @_; 1307 1308 return 1 unless @{$contents}; 1309 1310 if (open(FILE, ">$filename")) { 1311 print FILE @{$contents} or die "cannot write to $filename: $!"; 1312 close FILE or return 0; 1313 return 1; 1314 } 1315 1316 return 0; 1317} 1318 1319############################################################################## 1320 1321sub channel_failed { 1322 my $reason = shift; 1323 warn("$reason, channel failed\n"); 1324 $channel_failures++; 1325} 1326 1327############################################################################## 1328 1329sub taint_safe_archive_extract { 1330 my $todir = shift; 1331 my $input = shift; 1332 1333 my $tfh = IO::Zlib->new($input, "rb"); 1334 $tfh or die "fatal: couldn't read content tmpfile $content_file: $!\n"; 1335 1336 my $tar = Archive::Tar->new($tfh); 1337 $tar or die "fatal: couldn't open tar archive!\n"; 1338 1339 # stupid Archive::Tar is not natively taint-safe! duh. 1340 # return $tar->extract(); 1341 # instead, get the file list, untaint, and extract one-by-one. 1342 1343 my @files = $tar->list_files(); 1344 foreach my $file (@files) { 1345 next if ($file =~ /^\/$/); # ignore dirs 1346 1347 local($1); 1348 $file =~ /^([-\.\,\/a-zA-Z0-9_]+)$/; 1349 my $outfname = $1; 1350 $outfname =~ s/\.\.\//__\//gs; # avoid "../" dir traversal attacks 1351 $outfname = File::Spec->catfile($todir, $outfname); 1352 1353 dbg "extracting: $outfname"; 1354 if (!open OUT, ">".$outfname) { 1355 warn "error: failed to create $outfname: $!"; 1356 goto failed; 1357 } else { 1358 my $content = $tar->get_content($file); 1359 1360 if ($outfname =~ /\.(?:pre|cf)$/) { 1361 # replace macros in the update files if it's a .pre or .cf 1362 local($1); 1363 $content =~ s/\@\@([^\@]+)\@\@/$MACRO_VALUES{$1} || "\@\@$1\@\@"/ge; 1364 1365 # also, if --allowplugins is not specified, comment out 1366 # all loadplugin or tryplugin lines (and others that can load code) 1367 if ( !$opt{'allowplugins'} ) { 1368 $content =~ s{^\s*( 1369 loadplugin | 1370 tryplugin | 1371 \S+_modules? | 1372 \S+_factory | 1373 dcc_(?:path|options) | 1374 pyzor_(?:path|options) | 1375 extracttext_external 1376 )\s} 1377 {#(commented by sa-update, no --allowplugins switch specified)# $1}gmx; 1378 } 1379 1380 # other stuff never allowed for safety 1381 $content =~ s/^\s*(dns_server)/#(commented by sa-update, not allowed)# $1/gm; 1382 1383 # adjust scores 1384 if ($opt{'score-multiplier'} || $opt{'score-limit'}) { 1385 my $adjust_score = sub { 1386 my @scores = split(/\s+/, $_[1]); 1387 my $touched = 0; 1388 foreach (@scores) { 1389 next if $_ == 0; # Can't adjust if zero.. 1390 my $old = $_; 1391 $_ = $_ * $opt{'score-multiplier'} if $opt{'score-multiplier'}; 1392 $_ = $opt{'score-limit'} if $opt{'score-limit'} && $_ > $opt{'score-limit'}; 1393 if ($old != $_) { 1394 if ($_ == 0) { # Prevent zeroing scores 1395 $_ = $old < 0 ? "-0.001" : "0.001" 1396 } else { 1397 $_ = sprintf("%.3f", $_); 1398 } 1399 $touched++ if $old != $_; 1400 } 1401 } 1402 if ($touched) { 1403 return $_[0].join(' ', @scores)." #(score adjusted by sa-update, $_[1])#".$_[2]; 1404 } else { 1405 return $_[0].$_[1].$_[2]; 1406 } 1407 }; 1408 $content =~ s/^(\s*score\s+\w+\s+)(-?\d+(?:\.\d+)?(?:\s+-?\d+(?:\.\d+)?)*)(.*)$ 1409 /$adjust_score->($1,$2,$3)/igmex; 1410 } 1411 } 1412 1413 print OUT $content 1414 or do { warn "error writing to $outfname: $!"; goto failed }; 1415 close OUT 1416 or do { warn "error: write failed to $outfname: $!"; goto failed } 1417 } 1418 } 1419 1420 return @files; 1421 1422failed: 1423 return; # undef = failure 1424} 1425 1426############################################################################## 1427 1428# Do a generic DNS query 1429sub do_dns_query { 1430 my($query, $rr_type) = @_; 1431 $rr_type = 'TXT' if !defined $rr_type; 1432 1433 my $RR = $res->query($query, $rr_type); 1434 my @result; 1435 1436 # NOTE: $rr->rdatastr returns the result encoded in a DNS zone file 1437 # format, i.e. enclosed in double quotes if a result contains whitespace 1438 # (or other funny characters), and may use \DDD encoding or \X quoting as 1439 # per RFC 1035. Using $rr->txtdata instead avoids this unnecessary encoding 1440 # step and a need for decoding by a caller, returning an unmodified string. 1441 # Caveat: in case of multiple RDATA <character-string> fields contained 1442 # in a resource record (TXT, SPF, HINFO), starting with Net::DNS 0.69 1443 # the $rr->txtdata in a list context returns these strings as a list. 1444 # The $rr->txtdata in a scalar context always returns a single string 1445 # with <character-string> fields joined by a single space character as 1446 # a separator. The $rr->txtdata in Net::DNS 0.68 and older returned 1447 # such joined space-separated string even in a list context. 1448 # 1449 # From Net::DNS maintainers (Willem Toorop, NLnet Labs): 1450 # I encourage you to use txtdata for getting the values of 1451 # <version>.updates.spamassassin.org and mirros.updates.spamassassin.org. 1452 # As those records have only a single rdata field, txtdata would return 1453 # the same value since Net::DNS 0.34. 1454 # 1455 if ($RR) { 1456 foreach my $rr ($RR->answer) { 1457 next if !$rr; # no answer records, only rcode 1458 next if $rr->type ne $rr_type; 1459 # scalar context! 1460 my $text = $rr->UNIVERSAL::can('txtdata') ? $rr->txtdata : $rr->rdatastr; 1461 push(@result,$text) if defined $text && $text ne ''; 1462 } 1463 printf("DNS %s query: %s -> %s\n", $rr_type, $query, join(", ",@result)) 1464 if $opt{'verbose'} && $opt{'verbose'} > 1; 1465 } 1466 else { 1467 dbg("dns: query failed: $query => " . $res->errorstring); 1468 printf("DNS %s query %s failed: %s\n", $rr_type, $query, $res->errorstring) 1469 if $opt{'verbose'} && $opt{'verbose'} > 1; 1470 } 1471 1472 return @result; 1473} 1474 1475############################################################################## 1476 1477sub init_lwp { 1478 if ($have_inet6 && 1479 (!$opt{'force_pf'} || $opt{'force_pf'} eq 'inet6') && 1480 ($io_socket_module_name eq 'IO::Socket::IP' || 1481 $io_socket_module_name eq 'IO::Socket::INET6') ) 1482 { 1483 # LWP module has no support for IPv6. Use hotpatching, 1484 # copying IO::Socket::IP or IO::Socket::INET6 to IO::Socket::INET. 1485 # 'Borrowed' from Net::INET6Glue::INET_is_INET6 : 1486 1487 printf("http: (lwp) hotpatching IO::Socket::INET by module %s\n", 1488 $io_socket_module_name) if $opt{'verbose'}; 1489 my $io_socket_module_hash_name = $io_socket_module_name . '::'; 1490 my $io_socket_module_path = $io_socket_module_name . '.pm'; 1491 $io_socket_module_path =~ s{::}{/}g; 1492 $INC{'IO/Socket/INET.pm'} = $INC{$io_socket_module_path}; 1493 no strict 'refs'; 1494 no warnings 'redefine'; 1495 for ( keys %{$io_socket_module_hash_name} ) { 1496 ref(my $v = $io_socket_module_hash_name->{$_}) and next; 1497 *{ 'IO::Socket::INET::'.$_ } = 1498 \&{ $io_socket_module_hash_name . $_ } if *{$v}{CODE}; 1499 } 1500 } 1501 my $ua = LWP::UserAgent->new(); 1502 $ua->agent("sa-update/$VERSION/$SAVersion"); 1503 $ua->timeout(60); # a good long timeout; 10 is too short for Coral! 1504 $ua->env_proxy; 1505 1506# if ($opt{'force_pf'}) { 1507# # No longer needed and can be harmful as we don't know which address family 1508# # will be picked by the IO::Socket::* module in case of multihomed servers. 1509# # The IO::Socket::IP should choose the right protocol family automatically. 1510# if ($have_inet4 && $opt{'force_pf'} eq 'inet') { 1511# $ua->local_address('0.0.0.0'); 1512# } elsif ($have_inet6 && $opt{'force_pf'} eq 'inet6') { 1513# $ua->local_address('::'); 1514# } 1515# } 1516 1517 return $ua; 1518} 1519 1520# Do a GET request via HTTP for a certain URL 1521# Use the optional time_t value to do an IMS GET 1522sub http_get_lwp { 1523 my($url, $ims, $dir) = @_; 1524 1525 $have_lwp or die "http_get_lwp: module LWP not available"; 1526 $ua = init_lwp() if !$ua; 1527 1528 my $response; 1529 my $text; 1530 1531 # retry 3 times; this works better with Coral 1532 foreach my $retries (1 .. 3) { 1533 my $request = HTTP::Request->new("GET"); 1534 $request->url($url); 1535 1536 if (defined $ims) { 1537 my $str = time2str($ims); 1538 $request->header('If-Modified-Since', $str); 1539 dbg("http: IMS GET request, $url, $str"); 1540 } 1541 else { 1542 dbg("http: GET request, $url"); 1543 } 1544 1545 $response = $ua->request($request); 1546 1547 printf("http: (lwp) %sGET %s, %s\n", 1548 defined $ims ? 'IMS ' : '', $url, 1549 !$response ? '(no response)' : $response->status_line ) 1550 if $opt{'verbose'}; 1551 1552 if ($response->is_success) { 1553 return $response->content; 1554 } 1555 1556 # could be a "304 not modified" or similar. 1557 # TODO: should use a special return type for "not modified" here 1558 # instead of overloading the failure return type 1559 if ($ims && $response->status_line =~ /^3/) { 1560 return; 1561 } 1562 if ($response->status_line =~ /^[45]/) { 1563 # client error or server error, makes no sense retrying 1564 return; 1565 } 1566 1567 # include the text in the debug output; it's useful in some cases, 1568 # e.g. proxies that require authentication, diagnosing fascist 1569 # filtering false positives, etc. 1570 $text = $response->content; 1571 $text ||= "(no body)"; 1572 $text =~ s/\s+/ /gs; 1573 1574 dbg ("http: GET $url request failed, retrying: " . 1575 $response->status_line.": ".$text); 1576 } 1577 1578 # this should be a user-readable warning without --debug 1579 warn "http: GET $url request failed: " . 1580 $response->status_line.": ".$text."\n"; 1581 return; 1582} 1583 1584# Do a GET request via HTTP for a given URL using an external program, 1585# or fall back to LWP if no external downloading program is available. 1586sub http_get { 1587 my($url, $dir, $suggested_out_fname, $force_reload) = @_; 1588 my $content; 1589 1590 my $out_fname; 1591 if (defined $suggested_out_fname) { 1592 $out_fname = $suggested_out_fname; 1593 } else { 1594 local $1; 1595 $url =~ m{([^/]*)\z}s; 1596 my $url_fname = $1; 1597 $out_fname = File::Spec->catfile($dir, $url_fname); 1598 } 1599 $out_fname = untaint_var($out_fname); 1600 1601 # construct a short filename, relative to a current working directory $dir 1602 my $out_fname_short = $out_fname; 1603 $out_fname_short =~ s{^\Q$dir\E/*}{}; 1604 1605 printf("fetching %s\n", $url) if $opt{'verbose'} && $opt{'verbose'} > 1; 1606 dbg("http: url: %s", $url); 1607 1608 my $out_fname_exists = -e $out_fname; 1609 dbg("http: downloading to: %s, %s", $out_fname, 1610 !$out_fname_exists ? 'new' : $force_reload ? 'replace' : 'update'); 1611 1612 my($ext_prog, $cmd, @args); 1613 if (defined $opt{'httputil'}) { 1614 if ($opt{'httputil'} eq 'lwp') { 1615 if (!$have_lwp) { 1616 die "http: module LWP not available, download failed"; 1617 } 1618 } else { 1619 $ext_prog = $opt{'httputil'}; 1620 $cmd = Mail::SpamAssassin::Util::find_executable_in_env_path($ext_prog); 1621 if (!defined $cmd || $cmd eq '') { 1622 die "http: $ext_prog utility not found, download failed"; 1623 } 1624 } 1625 } else { 1626 foreach my $try_prog ('curl', 'wget', 'fetch') { 1627 $cmd = Mail::SpamAssassin::Util::find_executable_in_env_path($try_prog); 1628 if (defined $cmd && $cmd ne '') { $ext_prog = $try_prog; last } 1629 } 1630 } 1631 1632 if (defined $ext_prog && $ext_prog eq 'curl') { 1633 push(@args, qw(-s -L -O --remote-time -g --max-redirs 2 1634 --connect-timeout 30 --max-time 300 1635 --fail -o), $out_fname_short); 1636 push(@args, '-z', $out_fname_short) if $out_fname_exists && !$force_reload; 1637 push(@args, '-A', "sa-update/$VERSION/$SAVersion"); 1638 } elsif (defined $ext_prog && $ext_prog eq 'wget') { 1639 push(@args, qw(-q --max-redirect=2 --tries=3 1640 --dns-timeout=20 --connect-timeout=30 --read-timeout=300)); 1641 push(@args, defined $suggested_out_fname ? ('-O', $out_fname_short) 1642 : $force_reload ? () : ('-N') ); 1643 push(@args, '-U', "sa-update/$VERSION/$SAVersion"); 1644 } elsif (defined $ext_prog && $ext_prog eq 'fetch') { 1645 push(@args, qw(-q -n -a -w 20 -m -o), $out_fname_short); 1646 push(@args, '-m') if $out_fname_exists && !$force_reload; 1647 push(@args, "--user-agent=sa-update/$VERSION/$SAVersion"); 1648 } elsif ($have_lwp) { 1649 dbg("http: no external tool for download, fallback to using LWP") if !$opt{'httputil'}; 1650 my $ims; 1651 if ($out_fname_exists && !$force_reload) { 1652 my @out_fname_stat = stat($out_fname); 1653 my $size = $out_fname_stat[7]; 1654 $ims = $out_fname_stat[9] if $size; # only if nonempty 1655 } 1656 my $out_fh = IO::File->new; 1657 $out_fh->open($out_fname,'>',0640) 1658 or die "Cannot create a file $out_fname: $!"; 1659 binmode($out_fh) or die "Can't set binmode on $out_fname: $!"; 1660 $content = http_get_lwp($url, $ims, $dir); 1661 if (!defined $content) { 1662 dbg("http: (lwp) no content downloaded from %s", $url); 1663 } else { 1664 $out_fh->print($content) or die "Error writing to $out_fname: $!"; 1665 } 1666 $out_fh->close or die "Error closing file $out_fname: $!"; 1667 return ($out_fname, 1); 1668 } else { 1669 die "http: no downloading tool available"; 1670 } 1671 1672 # only reached if invoking an external program is needed (not lwp) 1673 if ($opt{'force_pf'}) { 1674 if ($opt{'force_pf'} eq 'inet') { push(@args, '-4') } 1675 elsif ($opt{'force_pf'} eq 'inet6') { push(@args, '-6') } 1676 } 1677 push(@args, '--', untaint_var($url)); 1678 dbg("http: %s", join(' ',$cmd,@args)); 1679 1680 # avoid a system() call, use fork/exec to make sure we avoid invoking a shell 1681 my $pid; 1682 eval { 1683 # use eval, the fork() sometimes signals an error 1684 # instead of returning a failure status 1685 $pid = fork(); 1; 1686 } or do { $@ = "errno=$!" if $@ eq ''; chomp $@; die "http fork: $@" }; 1687 defined $pid or die "spawning $cmd failed: $!"; 1688 if (!$pid) { # child 1689 chdir($dir) or die "Can't chdir to $dir: $!"; 1690 $cmd = untaint_file_path($cmd); 1691 exec {$cmd} ($cmd,@args); 1692 die "failed to exec $cmd: $!"; 1693 } 1694 1695 # parent 1696 waitpid($pid,0); 1697 my $child_stat = $?; 1698 dbg("http: process [%s], exit status: %s", 1699 $pid, exit_status_str($child_stat,0)); 1700 1701 if (!$opt{'verbose'}) { 1702 # silent 1703 } elsif ($child_stat == 0) { 1704 printf("http: (%s) GET %s, success\n", $ext_prog, $url); 1705 } else { 1706 printf("http: (%s) GET %s, FAILED, status: %s\n", 1707 $ext_prog, $url, exit_status_str($child_stat,0)); 1708 } 1709 1710 return ($out_fname, $child_stat == 0); 1711} 1712 1713# Read the content of a (downloaded) file. The subroutine expects a file name 1714# and a boolean value. The boolean value indicates whether the file should be 1715# opened in "text" mode or in "binary" mode. Pass 0 for text mode, 1 for binary 1716# mode. Returns the content of the file as a string. 1717sub read_content { 1718 my ($file_name, $binary_mode) = @_; 1719 1720 my $file = IO::File->new; 1721 if (!$file->open($file_name, '<')) { 1722 dbg("read_content: Cannot open file $file_name: $!"); 1723 return undef; ## no critic (ProhibitExplicitReturnUndef) 1724 } 1725 if ($binary_mode) { 1726 binmode $file; 1727 } 1728 1729 my($number_of_bytes,$buffer); 1730 my $content = ''; 1731 while (($number_of_bytes = $file->read($buffer, 16384)) > 0) { 1732 $content .= $buffer; 1733 } 1734 if (!defined $number_of_bytes) { 1735 dbg("read_content: Error reading from file $file_name: $!"); 1736 return undef; ## no critic (ProhibitExplicitReturnUndef) 1737 } 1738 $file->close; 1739 1740 return $content; 1741} 1742 1743############################################################################## 1744 1745# choose a random integer between 0 and the total weight of all mirrors 1746# loop through the mirrors from largest to smallest weight 1747# if random number is < largest weight, use it 1748# otherwise, random number -= largest, remove mirror from list, try again 1749# eventually, there'll just be 1 mirror left in $mirrors[0] and it'll be used 1750# 1751sub choose_mirror { 1752 my($mirror_list) = @_; 1753 1754 # Sort the mirror list by reverse weight (largest first) 1755 my @mirrors = sort { $mirror_list->{$b}->{weight} <=> $mirror_list->{$a}->{weight} } keys %{$mirror_list}; 1756 1757 return unless @mirrors; 1758 1759 if (keys %{$mirror_list} > 1) { 1760 # Figure out the total weight 1761 my $weight_total = 0; 1762 foreach (@mirrors) { 1763 $weight_total += $mirror_list->{$_}->{weight}; 1764 } 1765 1766 # Pick a random int 1767 my $value = int(rand($weight_total)); 1768 1769 # loop until we find the right mirror, or there's only 1 left 1770 while (@mirrors > 1) { 1771 if ($value < $mirror_list->{$mirrors[0]}->{weight}) { 1772 last; 1773 } 1774 $value -= $mirror_list->{$mirrors[0]}->{weight}; 1775 shift @mirrors; 1776 } 1777 } 1778 1779 return $mirrors[0]; 1780} 1781 1782############################################################################## 1783 1784sub check_mirror_af { 1785 my ($mirror) = @_; 1786 # RFC 3986: scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." ) 1787 $mirror =~ s{^([a-z][a-z0-9.+-]*)://}{}si; # strip scheme like http:// 1788 my $scheme = lc($1); 1789 # No DNS check needed for proxied connections (caveat: no_proxy is not checked) 1790 my $http_proxy = (defined $ENV{"http_proxy"} && $ENV{"http_proxy"} =~ /\S/) || 1791 (defined $ENV{"HTTP_PROXY"} && $ENV{"HTTP_PROXY"} =~ /\S/); 1792 my $https_proxy = (defined $ENV{"https_proxy"} && $ENV{"https_proxy"} =~ /\S/) || 1793 (defined $ENV{"HTTPS_PROXY"} && $ENV{"HTTPS_PROXY"} =~ /\S/); 1794 return 1 if $scheme eq "http" && $http_proxy; 1795 return 1 if $scheme eq "https" && $https_proxy; 1796 # No DNS check needed for IPv4 or IPv6 address literal 1797 return 1 if $use_inet4 && $mirror =~ m{^\d+\.\d+\.\d+\.\d+(?:[:/]|$)}; 1798 return 1 if $use_inet6 && $mirror =~ m{^\[}; 1799 $mirror =~ s{[:/].*}{}s; # strip all starting from :port or /path 1800 return 1 if $use_inet4 && do_dns_query($mirror, "A"); 1801 return 1 if $use_inet6 && do_dns_query($mirror, "AAAA"); 1802 return 0; 1803} 1804 1805############################################################################## 1806 1807sub print_version { 1808 printf("sa-update version %s\n running on Perl version %s\n", $VERSION, 1809 join(".", map( 0+($_||0), ( $] =~ /(\d)\.(\d{3})(\d{3})?/ )))); 1810} 1811 1812############################################################################## 1813 1814sub print_usage_and_exit { 1815 my ( $message, $exitval ) = @_; 1816 $exitval ||= 64; 1817 1818 if ($exitval == 0) { 1819 print_version(); 1820 print("\n"); 1821 } 1822 pod2usage( 1823 -verbose => 0, 1824 -message => $message, 1825 -exitval => $exitval, 1826 ); 1827} 1828 1829############################################################################## 1830 1831sub usage { 1832 my ( $verbose, $message ) = @_; 1833 print "sa-update version $VERSION\n"; 1834 pod2usage( -verbose => $verbose, -message => $message, -exitval => 64 ); 1835} 1836 1837############################################################################## 1838 1839sub interpolate_gpghomedir { 1840 my $gpghome = ''; 1841 if ($opt{'gpghomedir'}) { 1842 $gpghome = $opt{'gpghomedir'}; 1843 if (am_running_on_windows()) { 1844 # windows is single-quote-phobic; bug 4958 cmt 7 1845 $gpghome =~ s/\"/\\\"/gs; 1846 $gpghome = "--homedir=\"$gpghome\""; 1847 } else { 1848 $gpghome =~ s/\'/\\\'/gs; 1849 $gpghome = "--homedir='$gpghome'"; 1850 } 1851 } 1852 return $gpghome; 1853} 1854 1855############################################################################## 1856 1857sub check_gpghomedir { 1858 unless (-d $opt{gpghomedir}) { 1859 dbg("gpg: creating gpg home dir ".$opt{gpghomedir}); 1860 # use 0700 to avoid "unsafe permissions" warning 1861 mkpath([$opt{gpghomedir}], 0, 0700) 1862 or die "cannot mkpath $opt{gpghomedir}: $!"; 1863 } 1864} 1865 1866############################################################################## 1867sub import_gpg_key { 1868 my $keyfile = shift; 1869 1870 my $gpghome = interpolate_gpghomedir(); 1871 check_gpghomedir(); 1872 1873 my $CMD = "$GPGPath $gpghome --batch ". 1874 "--no-tty --status-fd=1 -q --logger-fd=1 --import"; 1875 1876 unless (open(CMD, "$CMD $keyfile|")) { 1877 die "fatal: couldn't execute $GPGPath: $!\n"; 1878 } 1879 1880 # Determine the fate of the signature 1881 while(my $GNUPG = <CMD>) { 1882 chop $GNUPG; 1883 dbg ("gpg: $GNUPG"); 1884 1885 if ($GNUPG =~ /^gpg: /) { 1886 warn $GNUPG."\n"; # report bad news 1887 } 1888 1889 if ($GNUPG =~ /^IMPORTED /) { 1890 dbg("gpg: gpg key imported successfully"); 1891 } 1892 } 1893 1894 my $errno = 0; close CMD or $errno = $!; 1895 proc_status_ok($?,$errno) 1896 or warn("gpg: process '$CMD' finished: ".exit_status_str($?,$errno)."\n"); 1897 1898 return ($? >> 8); 1899} 1900 1901############################################################################## 1902 1903sub import_default_keyring { 1904 my $defkey = File::Spec->catfile ($DEF_RULES_DIR, "sa-update-pubkey.txt"); 1905 unless (-f $defkey) { 1906 dbg("gpg: import of default keyring failed, couldn't find sa-update-pubkey.txt"); 1907 return; 1908 } 1909 1910 dbg("gpg: importing default keyring to ".$opt{gpghomedir}); 1911 check_gpghomedir(); 1912 import_gpg_key($defkey); 1913} 1914 1915############################################################################## 1916 1917sub is_valid_gpg_key_id { 1918 # either a keyid (8 bytes) or a fingerprint (40 bytes) 1919 return ($_[0] =~ /^[a-fA-F0-9]+$/ && (length $_[0] == 8 || length $_[0] == 40)); 1920} 1921 1922############################################################################## 1923 1924sub clean_update_dir { 1925 my($dir, $preserve_files_ref) = @_; 1926 1927 dbg("generic: cleaning directory %s", $dir); 1928 unless (opendir(DIR, $dir)) { 1929 warn "error: cannot opendir $dir: $!\n"; 1930 dbg("generic: attempt to opendir ($dir) failed"); 1931 return; 1932 } 1933 while(my $file = readdir(DIR)) { 1934 next if $file eq '.' || $file eq '..'; 1935 1936 my $path = File::Spec->catfile($dir, $file); 1937 if ($preserve_files_ref && $preserve_files_ref->{$path}) { 1938 dbg("generic: preserving $file"); 1939 next; 1940 } 1941 untaint_var(\$path); 1942 next unless -f $path; 1943 1944 dbg("generic: unlinking $file"); 1945 if (!unlink $path) { 1946 warn "error: cannot remove file $path: $!\n"; 1947 closedir(DIR) or die "cannot close directory $dir: $!"; 1948 return; 1949 } 1950 } 1951 closedir(DIR) or die "cannot close directory $dir: $!"; 1952 return 1; 1953} 1954 1955sub delete_files { 1956 my(@filenames) = @_; 1957 foreach my $path (@filenames) { 1958 dbg("generic: unlinking $path"); 1959 unlink $path or warn "error: cannot unlink file $path: $!\n"; 1960 } 1961 return 1; 1962} 1963 1964############################################################################## 1965 1966sub lint_check_dir { 1967 my $dir = shift; 1968 1969 # due to the Logger module's globalness (all M::SA objects share the same 1970 # Logger setup), we can't change the debug level here to only include 1971 # "config" or otherwise be more terse. :( 1972 my $spamtest = Mail::SpamAssassin->new( { 1973 rules_filename => $dir, 1974 site_rules_filename => $LOCAL_RULES_DIR, 1975 ignore_site_cf_files => 1, 1976 userprefs_filename => File::Spec->catfile($dir, "doesnotexist"), 1977 1978 local_tests_only => 1, 1979 dont_copy_prefs => 1, 1980 1981 PREFIX => $PREFIX, 1982 DEF_RULES_DIR => $DEF_RULES_DIR, 1983 LOCAL_RULES_DIR => $LOCAL_RULES_DIR, 1984 LOCAL_STATE_DIR => $LOCAL_STATE_DIR, 1985 }); 1986 1987 # need to kluge disabling bayes since it may try to expire the DB, and 1988 # without the proper config it's not going to be good. 1989 $spamtest->{conf}->{use_bayes} = 0; 1990 1991 my $res = $spamtest->lint_rules(); 1992 $spamtest->finish(); 1993 1994 return $res == 0; 1995} 1996 1997############################################################################## 1998 1999=head1 NAME 2000 2001sa-update - automate SpamAssassin rule updates 2002 2003=head1 SYNOPSIS 2004 2005B<sa-update> [options] 2006 2007Options: 2008 2009 --channel channel Retrieve updates from this channel 2010 Use multiple times for multiple channels 2011 --channelfile file Retrieve updates from the channels in the file 2012 --checkonly Check for update availability, do not install 2013 --install filename Install updates directly from this file. Signature 2014 verification will use "file.asc", "file.sha256", 2015 and "file.sha512". 2016 --allowplugins Allow updates to load plugin code (DANGEROUS) 2017 --gpgkey key Trust the key id to sign releases 2018 Use multiple times for multiple keys 2019 --gpgkeyfile file Trust the key ids in the file to sign releases 2020 --gpghomedir path Store the GPG keyring in this directory 2021 --gpg and --nogpg Use (or do not use) GPG to verify updates 2022 (--gpg is assumed by use of the above 2023 --gpgkey and --gpgkeyfile options) 2024 --import file Import GPG key(s) from file into sa-update's 2025 keyring. Use multiple times for multiple files 2026 --updatedir path Directory to place updates, defaults to the 2027 SpamAssassin site rules directory 2028 (default: @@LOCAL_STATE_DIR@@/@@VERSION@@) 2029 --refreshmirrors Force the MIRRORED.BY file to be updated 2030 --forcemirror url Use a specific mirror instead of downloading from 2031 official mirrors 2032 --httputil util Force used download tool. By default first found 2033 from these is used: curl, wget, fetch, lwp 2034 --score-multiplier x.x Adjust all scores from update channel, multiply 2035 with given value (integer or float). 2036 --score-limit x.x Adjust all scores from update channel, limit 2037 to given value (integer or float). Limiting 2038 is done after possible multiply operation. 2039 -D, --debug [area=n,...] Print debugging messages 2040 -v, --verbose Be verbose, like print updated channel names; 2041 For more verbosity specify multiple times 2042 -V, --version Print version 2043 -h, --help Print usage message 2044 -4 Force using the inet protocol (IPv4), not inet6 2045 -6 Force using the inet6 protocol (IPv6), not inet 2046 2047=head1 DESCRIPTION 2048 2049sa-update automates the process of downloading and installing new rules and 2050configuration, based on channels. The default channel is 2051I<updates.spamassassin.org>, which has updated rules since the previous 2052release. 2053 2054Update archives are verified using SHA256 and SHA512 hashes and GPG signatures, 2055by default. 2056 2057Note that C<sa-update> will not restart C<spamd> or otherwise cause 2058a scanner to reload the now-updated ruleset automatically. Instead, 2059C<sa-update> is typically used in something like the following manner: 2060 2061 sa-update && /etc/init.d/spamassassin reload 2062 2063This works because C<sa-update> only returns an exit status of C<0> if 2064it has successfully downloaded and installed an updated ruleset. 2065 2066The program sa-update uses the underlying operating system umask for the 2067updated rule files it installs. You may wish to run sa-update from a script 2068that sets the umask prior to calling sa-update. For example: 2069 2070 #!/bin/sh 2071 umask 022 2072 sa-update 2073 2074=head1 OPTIONS 2075 2076=over 4 2077 2078=item B<--channel> 2079 2080sa-update can update multiple channels at the same time. By default, it will 2081only access "updates.spamassassin.org", but more channels can be specified via 2082this option. If there are multiple additional channels, use the option 2083multiple times, once per channel. i.e.: 2084 2085 sa-update --channel foo.example.com --channel bar.example.com 2086 2087=item B<--channelfile> 2088 2089Similar to the B<--channel> option, except specify the additional channels in a 2090file instead of on the commandline. This is useful when there are a 2091lot of additional channels. 2092 2093=item B<--checkonly> 2094 2095Only check if an update is available, don't actually download and install it. 2096The exit code will be C<0> or C<1> as described below. 2097 2098=item B<--install> 2099 2100Install updates "offline", from the named tar.gz file, instead of performing 2101DNS lookups and HTTP invocations. 2102 2103Files named B<file>.sha256, B<file>.sha512, and B<file>.asc will be used for 2104the SHA256 and SHA512 hashes and the GPG signature, respectively. The filename 2105provided must contain a version number of at least 3 digits, which will be used 2106as the channel's update version number. 2107 2108Multiple B<--channel> switches cannot be used with B<--install>. To install 2109multiple channels from tarballs, run C<sa-update> multiple times with different 2110B<--channel> and B<--install> switches, e.g.: 2111 2112 sa-update --channel foo.example.com --install foo-34958.tgz 2113 sa-update --channel bar.example.com --install bar-938455.tgz 2114 2115=item B<--allowplugins> 2116 2117Allow downloaded updates to activate plugins. The default is not to 2118activate plugins; any C<loadplugin> or C<tryplugin> lines will be commented 2119in the downloaded update rules files. 2120 2121You should never enable this for 3rd party update channels, since plugins 2122can execute unrestricted code on your system, even possibly as root! This 2123includes spamassassin official updates, which have no need to include 2124running code. 2125 2126Use --reallyallowplugins option to bypass warnings and make it work. 2127 2128=item B<--gpg>, B<--nogpg> 2129 2130sa-update by default will verify update archives by use of SHA256 and SHA512 2131checksums and GPG signature. SHA* hashes can verify whether or not the 2132downloaded archive has been corrupted, but it does not offer any form of 2133security regarding whether or not the downloaded archive is legitimate 2134(aka: non-modifed by evildoers). GPG verification of the archive is used to 2135solve that problem. 2136 2137If you wish to skip GPG verification, you can use the B<--nogpg> option 2138to disable its use. Use of the following gpgkey-related options will 2139override B<--nogpg> and keep GPG verification enabled. 2140 2141Note: Currently, only GPG itself is supported (ie: not PGP). v1.2 has been 2142tested, although later versions ought to work as well. 2143 2144=item B<--gpgkey> 2145 2146sa-update has the concept of "release trusted" GPG keys. When an archive is 2147downloaded and the signature verified, sa-update requires that the signature 2148be from one of these "release trusted" keys or else verification fails. This 2149prevents third parties from manipulating the files on a mirror, for instance, 2150and signing with their own key. 2151 2152By default, sa-update trusts key ids C<24F434CE> and C<5244EC45>, which are 2153the standard SpamAssassin release key and its sub-key. Use this option to 2154trust additional keys. See the B<--import> option for how to add keys to 2155sa-update's keyring. For sa-update to use a key it must be in sa-update's 2156keyring and trusted. 2157 2158For multiple keys, use the option multiple times. i.e.: 2159 2160 sa-update --gpgkey E580B363 --gpgkey 298BC7D0 2161 2162Note: use of this option automatically enables GPG verification. 2163 2164=item B<--gpgkeyfile> 2165 2166Similar to the B<--gpgkey> option, except specify the additional keys in a file 2167instead of on the commandline. This is extremely useful when there are a lot 2168of additional keys that you wish to trust. 2169 2170=item B<--gpghomedir> 2171 2172Specify a directory path to use as a storage area for the C<sa-update> GPG 2173keyring. By default, this is 2174 2175 @@LOCAL_RULES_DIR@@/sa-update-keys 2176 2177=item B<--import> 2178 2179Use to import GPG key(s) from a file into the sa-update keyring which is 2180located in the directory specified by B<--gpghomedir>. Before using channels 2181from third party sources, you should use this option to import the GPG key(s) 2182used by those channels. You must still use the B<--gpgkey> or B<--gpgkeyfile> 2183options above to get sa-update to trust imported keys. 2184 2185To import multiple keys, use the option multiple times. i.e.: 2186 2187 sa-update --import channel1-GPG.KEY --import channel2-GPG.KEY 2188 2189Note: use of this option automatically enables GPG verification. 2190 2191=item B<--refreshmirrors> 2192 2193Force the list of sa-update mirrors for each channel, stored in the MIRRORED.BY 2194file, to be updated. By default, the MIRRORED.BY file will be cached for up to 21957 days after each time it is downloaded. 2196 2197=item B<--forcemirror> 2198 2199Force the download from a specific host instead of relying on mirrors listed 2200in MIRRORED.BY. 2201 2202=item B<--updatedir> 2203 2204By default, C<sa-update> will use the system-wide rules update directory: 2205 2206 @@LOCAL_STATE_DIR@@/@@VERSION@@ 2207 2208If the updates should be stored in another location, specify it here. 2209 2210Note that use of this option is not recommended; if you're just using sa-update 2211to download updated rulesets for a scanner, and sa-update is placing updates in 2212the wrong directory, you probably need to rebuild SpamAssassin with different 2213C<Makefile.PL> arguments, instead of overriding sa-update's runtime behaviour. 2214 2215=item B<-D> [I<area,...>], B<--debug> [I<area,...>] 2216 2217Produce debugging output. If no areas are listed, all debugging information is 2218printed. Diagnostic output can also be enabled for each area individually; 2219I<area> is the area of the code to instrument. For example, to produce 2220diagnostic output on channel, gpg, and http, use: 2221 2222 sa-update -D channel,gpg,http 2223 2224For more information about which areas (also known as channels) are 2225available, please see the documentation at 2226L<http://wiki.apache.org/spamassassin/DebugChannels>. 2227 2228=item B<-h>, B<--help> 2229 2230Print help message and exit. 2231 2232=item B<-V>, B<--version> 2233 2234Print sa-update version and exit. 2235 2236=back 2237 2238=head1 EXIT CODES 2239 2240In absence of a --checkonly option, an exit code of C<0> means: 2241an update was available, and was downloaded and installed successfully. 2242If --checkonly was specified, an exit code of C<0> means: an update was 2243available. 2244 2245An exit code of C<1> means no fresh updates were available. 2246 2247An exit code of C<2> means that at least one update is available but that a 2248lint check of the site pre files failed. The site pre files must pass a lint 2249check before any updates are attempted. 2250 2251An exit code of C<3> means that at least one update succeeded while 2252other channels failed. If using sa-compile, you should proceed with it. 2253 2254An exit code of C<4> or higher, indicates that errors occurred while 2255attempting to download and extract updates, and no channels were updated. 2256 2257=head1 SEE ALSO 2258 2259Mail::SpamAssassin(3) 2260Mail::SpamAssassin::Conf(3) 2261spamassassin(1) 2262spamd(1) 2263<http://wiki.apache.org/spamassassin/RuleUpdates> 2264 2265=head1 PREREQUISITES 2266 2267C<Mail::SpamAssassin> 2268 2269=head1 BUGS 2270 2271See <http://issues.apache.org/SpamAssassin/> 2272 2273=head1 AUTHORS 2274 2275The Apache SpamAssassin(tm) Project <https://spamassassin.apache.org/> 2276 2277=head1 LICENSE AND COPYRIGHT 2278 2279SpamAssassin is distributed under the Apache License, Version 2.0, as 2280described in the file C<LICENSE> included with the distribution. 2281 2282Copyright (C) 2015 The Apache Software Foundation 2283 2284 2285=cut 2286 2287