view release on metacpan or  search on metacpan

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

  return $self->first_existing_path(
    map { my $p = $_; $p =~ s{$}{/$filename}; $p } @paths );
}

=item $f-E<gt>create_default_prefs ($filename, $username [ , $userdir ] )

Copy default preferences file into home directory for later use and
modification, if it does not already exist and C<dont_copy_prefs> is
not set.

=cut

sub create_default_prefs {
  # $userdir will only exist if vpopmail config is enabled thru spamd
  # Its value will be the virtual user's maildir
  #
  my ($self, $fname, $user, $userdir) = @_;

  if ($self->{dont_copy_prefs}) {
    return(0);
  }

#  if ($userdir && $userdir ne $self->{user_dir}) {
#    warn "config: hooray! user_dirs don't match! '$userdir' vs '$self->{user_dir}'\n";
#  }

  my $stat_errn = stat($fname) ? 0 : 0+$!;
  if ($stat_errn == 0) {
    # fine, it already exists
  } elsif ($stat_errn != ENOENT) {
    dbg("config: cannot access user preferences file $fname: $!");
  } else {
    # Pass on the value of $userdir for virtual users in vpopmail
    # 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