1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
#!/usr/bin/perl -w
# This code is a part of Slash, and is released under the GPL.
# Copyright 1997-2001 by Open Source Development Network. See README
# and COPYING for more information, or see http://slashcode.com/.
# $Id: reload_armor,v 1.1.2.7 2001/07/25 16:52:07 jamie Exp $
use strict;
use FindBin '$Bin';
use Safe;
use File::Basename;
use Slash::Install;
use Getopt::Std;
(my $VERSION) = ' $Revision: 1.1.2.7 $ ' =~ /\$Revision:\s+([^\s]+)/;
my $PROGNAME = basename($0);
(my $PREFIX = $Bin) =~ s|/[^/]+/?$||;
my %opts;
# Remember to doublecheck these match usage()!
usage('Options used incorrectly') unless getopts('hvqu:', \%opts);
usage() if ($opts{'h'} || !keys %opts);
version() if $opts{'v'};
$opts{'u'} ||= 'slash';
# main program logic (in braces to offset nicely)
{
my $inst = new Slash::Install($opts{'u'});
my $site_install_dir = ($inst->get("site_install_directory"))->{value};
my $default_armor_file = "$site_install_dir/misc/spamarmors";
# Grab the sitename so we have a reasonable idea as to where the
# armor file may reside if it is not given on the commandline.
my $filename = $ARGV[0] || $default_armor_file;
my $armors = readArmorFile($filename);
# Perform syntax checks on all armor entries!
my $cpt = new Safe;
$cpt->permit(qw[:base_core :base_loop :base_math join]);
my %success = ( );
for my $a (@$armors) {
my $ok = 1;
local $_ = 'me\@privacy.net';
$cpt->reval($a->{code});
if ($@) {
warn "Error in armor '$a->{name}': $@\n";
$ok = 0;
} elsif ($_ eq 'me\@privacy.net') {
warn "Error in armor '$a->{name}': didn't change test address\n";
$ok = 0;
}
$success{$a} = $ok;
}
@$armors = grep { $success{$_} } @$armors;
if (my $n = $inst->reloadArmors($armors)) {
print "$n armoring codes loaded into database.\n" unless $opts{'q'};
}
}
# Subroutines
# Shamelessly based on Slash::Install::readTemplateFile()
sub readArmorFile {
my($filename) = @_;
my(@spam_armors);
return unless -f $filename;
open(FILE, $filename) or
die "$! unable to open file $filename to read from";
my $latch;
my $val;
my @file = <FILE>;
for (@file) {
chomp($_);
# Primitive commenting system. Ignore all lines beginning w/ '#'.
# Also ignore blank lines.
next if /^\s*(#|$)/;
# Insert data based on field break.
if (/^__(.*)__$/) {
# We only expect $1 to match 2 things here:
# "name" or "code". Case is irrelevant.
$latch = lc($1);
die "Invalid token in file!\n"
if $latch !~ /^name|code$/;
if ($latch eq 'name') {
push @spam_armors, $val if scalar keys %{$val};
$val = undef;
}
next;
}
$val->{$latch} .= $_ if $latch;
}
# Remember to store the last $val.
push @spam_armors, $val;
return \@spam_armors;
}
sub usage {
return if $opts{'q'};
print "*** $_[0]\n" if $_[0];
# Remember to doublecheck these match getopts()!
print <<EOT;
Usage: $PROGNAME [OPTIONS] ... {spamarmor_file}
SHORT PROGRAM DESCRIPTION
Main options:
-h Help (this message)
-q Quiet (no output to STDOUT)
-v Version
-u Virtual user (default is "slash")
Note: If {spamarmor_file} is not specified, then the default file for the given
site will be used. Default = <SLASH_PREFIX>/site/<SITENAME>/spamarmors
EOT
exit;
}
sub version {
return if $opts{'q'};
print <<EOT;
$PROGNAME $VERSION
This code is a part of Slash, and is released under the GPL.
Copyright 1997-2001 by Open Source Development Network. See README
and COPYING for more information, or see http://slashcode.com/.
EOT
exit;
}
__END__
|
