return ($reportfile, $tmpfile);

  return ($reportfile, $tmpfile);

}

}

###########################################################################

###########################################################################

sub uri_to_domain {

sub uri_to_domain {

# Standard perl modules

# Standard perl modules

use File::Spec;

use File::Spec;

use File::Path;

use File::Path;

use Getopt::Long;

use Getopt::Long;

use Pod::Usage;

use Pod::Usage;

use Config;

use Config;

# Clean up PATH appropriately

# Clean up PATH appropriately

Mail::SpamAssassin::Util::clean_path_in_taint_mode();

Mail::SpamAssassin::Util::clean_path_in_taint_mode();

# Default list of GPG keys allowed to sign update releases

# Default list of GPG keys allowed to sign update releases

#

#

# pub   1024D/265FA05B 2003-06-09

# pub   1024D/265FA05B 2003-06-09

#

#

my @channels = ( 'updates.spamassassin.org' );

my @channels = ( 'updates.spamassassin.org' );

my %opt = ();

my %opt = ();

@{$opt{'gpgkey'}} = ();

@{$opt{'gpgkey'}} = ();

@{$opt{'channel'}} = ();

@{$opt{'channel'}} = ();

  $opt{$optkey} = $1;

  $opt{$optkey} = $1;

}

}

if (@{$opt{'gpgkey'}}) {

if (@{$opt{'gpgkey'}}) {

  $GPG_ENABLED = 1;

  $GPG_ENABLED = 1;

  foreach my $key (@{$opt{'gpgkey'}}) {

  foreach my $key (@{$opt{'gpgkey'}}) {

    $valid_GPG{$key} = 1;

    $valid_GPG{$key} = 1;

  }

  }

}

}

if (defined $opt{'gpgkeyfile'}) {

if (defined $opt{'gpgkeyfile'}) {

  $GPG_ENABLED = 1;

  $GPG_ENABLED = 1;

  unless (open(GPG, $opt{'gpgkeyfile'})) {

  unless (open(GPG, $opt{'gpgkeyfile'})) {

  }

  }

  close(GPG);

  close(GPG);

}

}

  if(!-f File::Spec->catfile($opt{'gpghomedir'}, "secring.gpg")) {

  if(!-f File::Spec->catfile($opt{'gpghomedir'}, "secring.gpg")) {

    import_default_keyring();

    import_default_keyring();

    # attempt to continue even if this fails, anyway

    # attempt to continue even if this fails, anyway

  }

  }

}

}

# Deal with channel-related options

# Deal with channel-related options

if (defined $opt{'channel'} && scalar @{$opt{'channel'}} > 0) {

if (defined $opt{'channel'} && scalar @{$opt{'channel'}} > 0) {

  @channels = @{$opt{'channel'}};

  @channels = @{$opt{'channel'}};

  }

  }

}

}

my $res = Net::DNS::Resolver->new();

my $res = Net::DNS::Resolver->new();

my $ua = LWP::UserAgent->new();

my $ua = LWP::UserAgent->new();

# Generate a temporary file to put channel content in for later use ...

# Generate a temporary file to put channel content in for later use ...

my ($content_file, $tfh) = Mail::SpamAssassin::Util::secure_tmpfile();

my ($content_file, $tfh) = Mail::SpamAssassin::Util::secure_tmpfile();

close($tfh);

close($tfh);

# by default, exit code is 1, to indicate no updates occurred

# by default, exit code is 1, to indicate no updates occurred

my $exit = 1;

my $exit = 1;

# Go ahead and loop through all of the channels

# Go ahead and loop through all of the channels

foreach my $channel (@channels) {

foreach my $channel (@channels) {

  dbg("channel: attempting channel $channel");

  dbg("channel: attempting channel $channel");

  my $nicechannel = $channel;

  my $nicechannel = $channel;

  $nicechannel =~ tr/A-Za-z0-9-/_/cs;

  $nicechannel =~ tr/A-Za-z0-9-/_/cs;

  my $CFFile = "$UPDDir.cf";

  my $CFFile = "$UPDDir.cf";

  dbg("channel: update directory $UPDDir");

  dbg("channel: update directory $UPDDir");

  dbg("channel: channel cf file $CFFile");

  dbg("channel: channel cf file $CFFile");

  # try to read metadata from channel.cf file

  # try to read metadata from channel.cf file

  my $currentV = -1;

  my $currentV = -1;

  if (open(CF, $CFFile)) {

  if (open(CF, $CFFile)) {

    next;

    next;

  }

  }

  }

  }

  else {

  else {

    # We don't currently have the list of mirrors, so go grab it.

    # We don't currently have the list of mirrors, so go grab it.

      warn "error: no mirror data available for channel $channel\n";

      warn "error: no mirror data available for channel $channel\n";

      channel_failed("channel: MIRRORED.BY file location was not in DNS");

      channel_failed("channel: MIRRORED.BY file location was not in DNS");

    }

    }

      warn "error: no mirror data available for channel $channel\n";

      warn "error: no mirror data available for channel $channel\n";

      channel_failed("channel: MIRRORED.BY contents were missing");

      channel_failed("channel: MIRRORED.BY contents were missing");

      next;

      next;

    }

    }

    dbg("channel: MIRRORED.BY file retrieved");

    dbg("channel: MIRRORED.BY file retrieved");

  }

  }

  # Read in the list of mirrors

  # Read in the list of mirrors

  dbg("channel: reading MIRRORED.BY file");

  dbg("channel: reading MIRRORED.BY file");

  my %mirrors = ();

  my %mirrors = ();

    next if ($mirror =~ /^#/);  # explicitly skip comments

    next if ($mirror =~ /^#/);  # explicitly skip comments

    # We only support HTTP right now

    # We only support HTTP right now

      $mirrors{$mirror}->{$k} = $v;

      $mirrors{$mirror}->{$k} = $v;

    }

    }

  }

  }

  unless (keys %mirrors) {

  unless (keys %mirrors) {

    warn "error: no mirrors available for channel $channel\n";

    warn "error: no mirrors available for channel $channel\n";

    next;

    next;

  }

  }

  # Now that we've laid the foundation, go grab the appropriate files

  # Now that we've laid the foundation, go grab the appropriate files

  #

  #

  my $content;

  my $content;

  my $SHA1;

  my $SHA1;

  my $GPG;

  my $GPG;

  # Loop through all available mirrors, choose from them randomly

  # Loop through all available mirrors, choose from them randomly

  # if the archive get fails, choose another mirror,

  # if the archive get fails, choose another mirror,

    # try to update our list of mirrors.

    # try to update our list of mirrors.

    # a failure here doesn't cause channel failure.

    # a failure here doesn't cause channel failure.

    last;

    last;

  }

  }

  unless ($content && $SHA1 && (!$GPG_ENABLED || $GPG)) {

  unless ($content && $SHA1 && (!$GPG_ENABLED || $GPG)) {

    channel_failed("channel: could not find working mirror");

    channel_failed("channel: could not find working mirror");

    next;

    next;

  }

  }

  $SHA1 =~ /^([a-fA-F0-9]{40})/;

  $SHA1 =~ /^([a-fA-F0-9]{40})/;

  $SHA1 = $1 || 'INVALID';

  $SHA1 = $1 || 'INVALID';

  my $digest = sha1_hex($content);

  my $digest = sha1_hex($content);

  unless ($digest eq $SHA1) {

  unless ($digest eq $SHA1) {

    channel_failed("channel: SHA1 verification failed");

    channel_failed("channel: SHA1 verification failed");

    next;

    next;

  }

  }

    dbg("gpg: populating temp signature file");

    dbg("gpg: populating temp signature file");

    my $sig_file;

    my $sig_file;

    ($sig_file, $tfh) = Mail::SpamAssassin::Util::secure_tmpfile();

    ($sig_file, $tfh) = Mail::SpamAssassin::Util::secure_tmpfile();

    binmode $tfh;

    binmode $tfh;

    print $tfh $GPG;

    print $tfh $GPG;

    close($tfh);

    close($tfh);

  }

  }

  # OK, we're all validated at this point, install the new version

  # OK, we're all validated at this point, install the new version

  }

  }

  }

  }

  dbg("channel: extracting archive");

  dbg("channel: extracting archive");

    channel_failed("channel: archive extraction failed");

    channel_failed("channel: archive extraction failed");

    next;

    next;

  }

  }

  # check --lint

  # check --lint

  if (!lint_check_dir($UPDTmp)) {

  if (!lint_check_dir($UPDTmp)) {

    channel_failed("channel: lint check of update failed");

    channel_failed("channel: lint check of update failed");

    next;

    next;

  }

  }

  }

  }

  }

  }

  }

  }

  while(my $file = readdir(DIR)) {

  while(my $file = readdir(DIR)) {

    $file = $1;

    $file = $1;

    if ($file =~ /\.cf$/) {

    if ($file =~ /\.cf$/) {

    }

    }

  }

  }

  closedir(DIR);

  closedir(DIR);

    next;

    next;

  }

  }

  }

  }

  $exit = 0;            # "exit 0" means an update occurred

  $exit = 0;            # "exit 0" means an update occurred

  dbg("channel: update complete");

  dbg("channel: update complete");

}

}

# clear out the temp files if they still exist

# clear out the temp files if they still exist

    unlink $_ || warn "error: can't remove file $_: $!\n";

    unlink $_ || warn "error: can't remove file $_: $!\n";

  }

  }

}

}

dbg("diag: updates complete, exiting with code $exit");

dbg("diag: updates complete, exiting with code $exit");

exit $exit;

exit $exit;

sub channel_failed {

sub channel_failed {

  my $reason = shift;

  my $reason = shift;

  warn("$reason, channel failed\n");

  warn("$reason, channel failed\n");

  }

  }

}

}

sub taint_safe_archive_extract {

sub taint_safe_archive_extract {

  my $todir = shift;

  my $todir = shift;

  # stupid Archive::Tar is not natively taint-safe! duh.

  # stupid Archive::Tar is not natively taint-safe! duh.

  # return $tar->extract();

  # return $tar->extract();

  # instead, get the file list, untaint, and extract one-by-one.

  # instead, get the file list, untaint, and extract one-by-one.

    $file =~ /^([-\.\,\/a-zA-Z0-9_]+)$/;

    $file =~ /^([-\.\,\/a-zA-Z0-9_]+)$/;

    my $outfname = $1;

    my $outfname = $1;

    $outfname =~ s/\.\.\//__\//gs;      # avoid "../" dir traversal attacks

    $outfname =~ s/\.\.\//__\//gs;      # avoid "../" dir traversal attacks

    dbg "extracting: $outfname";

    dbg "extracting: $outfname";

    if (open OUT, ">".$outfname) {

    if (open OUT, ">".$outfname) {

  return;       # undef = failure

  return;       # undef = failure

}

}

# Do a generic TXT query

# Do a generic TXT query

sub do_txt_query {

sub do_txt_query {

  my($query) = shift;

  my($query) = shift;

  return $result;

  return $result;

}

}

# Do a GET request via HTTP for a certain URL

# Do a GET request via HTTP for a certain URL

# Use the optional time_t value to do an IMS GET

# Use the optional time_t value to do an IMS GET

sub http_get {

sub http_get {

  return;

  return;

}

}

# choose a random integer between 0 and the total weight of all mirrors

# choose a random integer between 0 and the total weight of all mirrors

# loop through the mirrors from largest to smallest weight

# loop through the mirrors from largest to smallest weight

# if random number is < largest weight, use it

# if random number is < largest weight, use it

  return $mirrors[0];

  return $mirrors[0];

}

}

sub print_version {

sub print_version {

  print "sa-update version $VERSION\n"

  print "sa-update version $VERSION\n"

      . "  running on Perl version " . join(".", map { $_||=0; $_*1 } ($] =~ /(\d)\.(\d{3})(\d{3})?/ )) . "\n";

      . "  running on Perl version " . join(".", map { $_||=0; $_*1 } ($] =~ /(\d)\.(\d{3})(\d{3})?/ )) . "\n";

}

}

sub print_usage_and_exit {

sub print_usage_and_exit {

  my ( $message, $exitval ) = @_;

  my ( $message, $exitval ) = @_;

  $exitval ||= 64;

  $exitval ||= 64;

  );

  );

}

}

sub usage {

sub usage {

  my ( $verbose, $message ) = @_;

  my ( $verbose, $message ) = @_;

  print "sa-update version $VERSION\n";

  print "sa-update version $VERSION\n";

  pod2usage( -verbose => $verbose, -message => $message, -exitval => 64 );

  pod2usage( -verbose => $verbose, -message => $message, -exitval => 64 );

}

}

sub interpolate_gpghomedir {

sub interpolate_gpghomedir {

  my $gpghome = '';

  my $gpghome = '';

  if ($opt{'gpghomedir'}) {

  if ($opt{'gpghomedir'}) {

  return $gpghome;

  return $gpghome;

}

}

sub import_gpg_key {

sub import_gpg_key {

  my $keyfile = shift;

  my $keyfile = shift;

  my $gpghome = interpolate_gpghomedir();

  my $gpghome = interpolate_gpghomedir();

  my $CMD = "$GPGPath $gpghome --batch ".

  my $CMD = "$GPGPath $gpghome --batch ".

    }

    }

    if ($GNUPG =~ /^IMPORTED /) {

    if ($GNUPG =~ /^IMPORTED /) {

    }

    }

  }

  }

  return ($? >> 8);

  return ($? >> 8);

}

}

sub import_default_keyring {

sub import_default_keyring {

  my $defkey = File::Spec->catfile ($DEF_RULES_DIR, "sa-update-pubkey.txt");

  my $defkey = File::Spec->catfile ($DEF_RULES_DIR, "sa-update-pubkey.txt");

  unless (-d $opt{gpghomedir}) {

  unless (-d $opt{gpghomedir}) {

    # use 0700 to avoid "unsafe permissions" warning

    # use 0700 to avoid "unsafe permissions" warning

  } 

  } 

  import_gpg_key($defkey);

  import_gpg_key($defkey);

}

}

sub is_valid_gpg_key_id {

sub is_valid_gpg_key_id {

  # either a keyid (8 bytes) or a fingerprint (40 bytes)

  # either a keyid (8 bytes) or a fingerprint (40 bytes)

  return ($_[0] =~ /^[a-fA-F0-9]+$/ && (length $_[0] == 8 || length $_[0] == 40));

  return ($_[0] =~ /^[a-fA-F0-9]+$/ && (length $_[0] == 8 || length $_[0] == 40));

}

}

sub clean_update_dir {

sub clean_update_dir {

  my $dir = shift;

  my $dir = shift;

  unless (opendir(DIR, $dir)) {

  unless (opendir(DIR, $dir)) {

    warn "error: can't readdir $dir: $!\n";

    warn "error: can't readdir $dir: $!\n";

  }

  }

  while(my $file = readdir(DIR)) {

  while(my $file = readdir(DIR)) {

    $file = $1;

    $file = $1;

    }

    }

  }

  }

  closedir(DIR);

  closedir(DIR);

  return 1;

  return 1;

}

}

sub lint_check_dir {

sub lint_check_dir {

  my $dir = shift;

  my $dir = shift;

  # "config" or otherwise be more terse. :(

  # "config" or otherwise be more terse. :(

  my $spamtest = new Mail::SpamAssassin( {

  my $spamtest = new Mail::SpamAssassin( {

    rules_filename      => $dir,

    rules_filename      => $dir,

    local_tests_only    => 1,

    local_tests_only    => 1,

    dont_copy_prefs     => 1,

    dont_copy_prefs     => 1,

  return $res == 0;

  return $res == 0;

}

}

=head1 NAME

=head1 NAME

sa-update - automate SpamAssassin rule updates

sa-update - automate SpamAssassin rule updates

Mail::SpamAssassin::Conf(3)

Mail::SpamAssassin::Conf(3)

spamassassin(1)

spamassassin(1)

spamd(1)

spamd(1)

=head1 PREREQUESITES

=head1 PREREQUESITES