getpwuid results from the CPAN

Mail-SpamAssassin

=back


=cut

# undocumented ctor settings: 
#
# - keep_config_parsing_metadata: used by build/listpromotable, default 0

sub new {
  my $class = shift;
  $class = ref($class) || $class;

  my $self = shift;
  if (!defined $self) { $self = { }; }
  bless ($self, $class);

  # basic backward compatibility; debug used to be a boolean.
  # translate that into 'all', which is what it meant before 3.1.0.
  if ($self->{debug} && $self->{debug} eq '1') {
    $self->{debug} = 'all';
  }

  # enable or disable debugging
  Mail::SpamAssassin::Logger::add_facilities($self->{debug});

  # first debugging information possibly printed should be the version
  dbg("generic: SpamAssassin version " . Version());

  # if the libs are installed in an alternate location, and the caller
  # didn't set PREFIX, we should have an estimated guess ready, values
  # substituted at 'make' time
  $self->{PREFIX}		||= '@@PREFIX@@';
  $self->{DEF_RULES_DIR}	||= '@@DEF_RULES_DIR@@';
  $self->{LOCAL_RULES_DIR}	||= '@@LOCAL_RULES_DIR@@';
  $self->{LOCAL_STATE_DIR}	||= '@@LOCAL_STATE_DIR@@';
  dbg("generic: Perl %s, %s", $], join(", ", map { $_ . '=' . $self->{$_} } 
      qw(PREFIX DEF_RULES_DIR LOCAL_RULES_DIR LOCAL_STATE_DIR)));

  $self->{needed_tags} = {};
  { my $ntags = $self->{need_tags};
    if (defined $ntags) {
      for my $t (ref $ntags ? @$ntags : split(/[, \s]+/,$ntags)) {
        $self->{needed_tags}->{$2} = !defined($1)  if $t =~ /^(NO)?(.+)\z/si;
      }
    }
  }
  if (would_log('dbg','timing') || $self->{needed_tags}->{TIMING}) {
    $self->timer_enable();
  }

  $self->{conf} ||= Mail::SpamAssassin::Conf->new($self);
  $self->{plugins} = Mail::SpamAssassin::PluginHandler->new($self);

  $self->{save_pattern_hits} ||= 0;

  # Make sure that we clean $PATH if we're tainted
  Mail::SpamAssassin::Util::clean_path_in_taint_mode();

  if (!defined $self->{username}) {
    $self->{username} = (Mail::SpamAssassin::Util::portable_getpwuid ($>))[0];
  }

  $self->create_locker();

  $self;
}

sub create_locker {
  my ($self) = @_;

  my $class;
  my $m = $self->{conf}->{lock_method};

  # let people choose what they want -- even if they may not work on their
  # OS.  (they could be using cygwin!)
  if ($m eq 'win32') { $class = 'Win32'; }
  elsif ($m eq 'flock') { $class = 'Flock'; }
  elsif ($m eq 'nfssafe') { $class = 'UnixNFSSafe'; }
  else {
    # OS-specific defaults
    if (am_running_on_windows()) {
      $class = 'Win32';
    } else {
      $class = 'UnixNFSSafe';
    }
  }

  # this could probably be made a little faster; for now I'm going
  # for slow but safe, by keeping in quotes
  eval '
    use Mail::SpamAssassin::Locker::'.$class.';
    $self->{locker} = Mail::SpamAssassin::Locker::'.$class.'->new($self);
    1;
  ' or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    die "Mail::SpamAssassin::Locker::$class error: $eval_stat\n";
  };

  if (!defined $self->{locker}) { die "locker: oops! no locker"; }
}

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

=item parse($message, $parse_now [, $suppl_attrib])

Parse will return a Mail::SpamAssassin::Message object with just the
headers parsed.  When calling this function, there are two optional
parameters that can be passed in: $message is either undef (which
will use STDIN), a scalar - a string containing an entire message,
a reference to such string, an array reference of the message with
one line per array element, or either a file glob or an IO::File object
which holds the entire contents of the message;  and $parse_now, which
specifies whether or not to create a MIME tree at parse time or later
as necessary.

The I<$parse_now> option, by default, is set to false (0).  This
allows SpamAssassin to not have to generate the tree of internal
data nodes if the information is not going to be used.  This is
handy, for instance, when running C<spamassassin -d>, which only
needs the pristine header and body which is always parsed and stored

lib/Mail/SpamAssassin.pm view on Meta::CPAN

  my $fname;

  # If vpopmail is enabled then set fname to virtual homedir
  # precedence: dir, userstate_dir, derive from user_dir, system default
  if (defined $dir) {
    $fname = File::Spec->catdir ($dir, ".spamassassin");
  }
  elsif (defined $self->{userstate_dir}) {
    $fname = $self->{userstate_dir};
  }
  elsif (defined $self->{user_dir}) {
    $fname = File::Spec->catdir ($self->{user_dir}, ".spamassassin");
  }

  $fname ||= $self->first_existing_path (@default_userstate_dir);

  # bug 4932: use the last default_userstate_dir entry if none of the others
  # already exist
  $fname ||= $self->sed_path($default_userstate_dir[-1]);

  if (!$self->{dont_copy_prefs}) {
    dbg("config: using \"$fname\" for user state dir");
  }

  # if this is not a dir, not readable, or we are unable to create the dir,
  # this is not (yet) a serious error; in fact, it's not even worth
  # a warning at all times, so use dbg().  see bug 6268
  my $stat_errn = stat($fname) ? 0 : 0+$!;
  if ($stat_errn == 0 && !-d _) {
    dbg("config: $fname exists but is not a directory");
  } elsif ($stat_errn != 0 && $stat_errn != ENOENT) {
    dbg("config: error accessing $fname: $!");
  } else {  # does not exist, create it
    eval {
      mkpath(Mail::SpamAssassin::Util::untaint_file_path($fname), 0, 0700);  1;
    } or do {
      my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
      dbg("config: mkdir $fname failed: $eval_stat");
    };
  }

  $fname;
}

# find the most global writable state dir
# used by dns_block_rule state files etc
sub set_global_state_dir {
  my ($self) = @_;
  # try home_dir_for_helpers
  my $helper_dir = $self->{home_dir_for_helpers} || '';
  if ($helper_dir) {
    my $dir = File::Spec->catdir($helper_dir, ".spamassassin");
    return if $self->test_global_state_dir($dir);
  }
  # try user home (if different from helper home)
  my $home;
  if (am_running_on_windows()) {
    # Windows has a special folder for common appdata (Bug 8050)
    $home = Mail::SpamAssassin::Util::common_application_data_directory();
  } else {
    $home = (Mail::SpamAssassin::Util::portable_getpwuid ($>))[7];
  }
  if ($home && $home ne $helper_dir) {
    my $dir = File::Spec->catdir($home, ".spamassassin");
    return if $self->test_global_state_dir($dir);
  }
  # try LOCAL_STATE_DIR
  return if $self->test_global_state_dir($self->{LOCAL_STATE_DIR});
  # fallback to userstate
  $self->{global_state_dir} = $self->get_and_create_userstate_dir();
  dbg("config: global_state_dir set to userstate_dir: $self->{global_state_dir}");
}

sub test_global_state_dir {
    my ($self, $dir) = @_;
    eval { mkpath($dir, 0, 0700); }; # just a single stat if exists already
    # Purge stale test files (enough to do only some times randomly)
    if (rand() < 0.2 && opendir(WT_DIR, $dir)) {
      foreach (grep {index($_, '.sawritetest') == 0 &&
                 (-M File::Spec->catfile($dir, $_)||0) > 0.0001} readdir(WT_DIR)) {
        unlink(Mail::SpamAssassin::Util::untaint_file_path(File::Spec->catfile($dir, $_)));
      }
      closedir WT_DIR;
    }
    my $n = ".sawritetest$$".Mail::SpamAssassin::Util::pseudo_random_string(6);
    my $file = File::Spec->catfile($dir, $n);
    if (Mail::SpamAssassin::Util::touch_file($file, { create_exclusive => 1 })) {
      dbg("config: global_state_dir set to $dir");
      $self->{global_state_dir} = $dir;
      unlink($file);
      return 1;
    }
    unlink($file); # just in case?
    return 0;
}

=item $fullpath = $f-E<gt>find_rule_support_file ($filename)

Find a rule-support file, such as C<languages> or C<triplets.txt>,
in the system-wide rules directory, and return its full path if
it exists, or undef if it doesn't exist.

(This API was added in SpamAssassin 3.1.1.)

=cut

sub find_rule_support_file {
  my ($self, $filename) = @_;

  my @paths;
  # search custom directories first
  if ($self->{site_rules_filename}) {
    foreach my $path (split("\000", $self->{site_rules_filename})) {
      push @paths, $path  if -d $path;
    }
  }
  if ($self->{rules_filename} && -d $self->{rules_filename}) {
    push @paths, $self->{rules_filename}
  }
  # updates sub-directory missing from @default_rules_path
  push @paths, '__local_state_dir__/__version__/updates_spamassassin_org';

lib/Mail/SpamAssassin.pm view on Meta::CPAN

    # otherwise it is empty and the user's normal homedir is used
    $self->get_and_create_userstate_dir($userdir);

    # copy in the default one for later editing
    my $defprefs =
      $self->first_existing_path(@Mail::SpamAssassin::default_prefs_path);

    local(*IN,*OUT);
    $fname = Mail::SpamAssassin::Util::untaint_file_path($fname);
    if (!defined $defprefs) {
      warn "config: can not determine default prefs path\n";
    } elsif (!open(IN, "<$defprefs")) {
      warn "config: cannot open $defprefs: $!\n";
    } elsif (!open(OUT, ">$fname")) {
      warn "config: cannot create user preferences file $fname: $!\n";
    } else {
      # former code skipped lines beginning with '#* ', the following copy
      # procedure no longer does so, as it avoids reading line-by-line
      my($inbuf,$nread);
      while ( $nread=read(IN,$inbuf,16384) ) {
        print OUT $inbuf  or die "cannot write to $fname: $!";
      }
      defined $nread  or die "error reading $defprefs: $!";
      undef $inbuf;
      close OUT or die "error closing $fname: $!";
      close IN  or die "error closing $defprefs: $!";

      if (($< == 0) && ($> == 0) && defined($user)) { # chown it
        my ($uid,$gid) = (getpwnam(untaint_var($user)))[2,3];
        unless (chown($uid, $gid, $fname)) {
          warn "config: couldn't chown $fname to $uid:$gid for $user: $!\n";
        }
      }
      warn "config: created user preferences file: $fname\n";
      return(1);
    }
  }

  return(0);
}

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

sub expand_name {
  my ($self, $name) = @_;
  my $home = $self->{user_dir} || $ENV{HOME} || '';

  if (am_running_on_windows()) {
    my $userprofile = $ENV{USERPROFILE} || '';

    return $userprofile if ($userprofile && $userprofile =~ m/^[a-z]\:[\/\\]/i);
    return $userprofile if ($userprofile =~ m/^\\\\/);

    return $home if ($home && $home =~ m/^[a-z]\:[\/\\]/i);
    return $home if ($home =~ m/^\\\\/);

    return '';
  } else {
    return $home if ($home && index($home, '/') != -1);
    return (getpwnam($name))[7] if ($name ne '');
    return (getpwuid($>))[7];
  }
}

sub sed_path {
  my ($self, $path) = @_;
  return if !defined $path;

  if (exists($self->{conf}->{sed_path_cache}->{$path})) {
    return $self->{conf}->{sed_path_cache}->{$path};
  }

  # <4.0 compatibility check, to be removed in 4.1
  my $check_compat = $path eq '__userstate__/auto-welcomelist';

  my $orig_path = $path;

  $path =~ s/__local_rules_dir__/$self->{LOCAL_RULES_DIR} || ''/ges;
  $path =~ s/__local_state_dir__/$self->{LOCAL_STATE_DIR} || ''/ges;
  $path =~ s/__def_rules_dir__/$self->{DEF_RULES_DIR} || ''/ges;
  $path =~ s{__prefix__}{$self->{PREFIX} || $Config{prefix} || '/usr'}ges;
  $path =~ s{__userstate__}{$self->get_and_create_userstate_dir() || ''}ges;
  $path =~ s/__global_state_dir__/$self->{global_state_dir} || ''/ges;
  $path =~ s{__perl_major_ver__}{$self->get_perl_major_version()}ges;
  $path =~ s/__version__/${VERSION}/gs;
  $path =~ s/^\~([^\/]*)/$self->expand_name($1)/es;

  # <4.0 compatibility check, to be removed in 4.1
  if ($check_compat) {
    if ($path =~ m{^(.+)/(.+)$}) {
      # Use auto-whitelist if found
      if (!-e $path && -e "$1/auto-whitelist") {
        $path = "$1/auto-whitelist";
      }
    }
  }

  $path = Mail::SpamAssassin::Util::untaint_file_path ($path);
  $self->{conf}->{sed_path_cache}->{$orig_path} = $path;
  return $path;
}

sub get_perl_major_version {
  my $self = shift;
  $] =~ /^(\d\.\d\d\d)/ or die "bad perl ver $]";
  return $1;
}

sub first_existing_path {
  my $self = shift;
  my $path;
  foreach my $p (@_) {
    $path = $self->sed_path ($p);
    if (defined $path) {
      my($errn) = stat($path) ? 0 : 0+$!;
      if    ($errn == ENOENT) { }  # does not exist
      elsif ($errn) {  warn "config: path \"$path\" is inaccessible: $!\n" }
      else { return $path }
    }
  }
  return;

( run in 3.574 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )