verifyemail.pl
Copying Source is Forbidden
118 lines of code
1
#!/usr/local/bin/perl
2
3
# must have's!
4
use strict;
5
use warnings;
6
use CGI::Carp qw(fatalsToBrowser);
7
use URI::Escape;
8
use HTML::Restrict;
9
10
use lib "/var/www/html/Pm";
11
12
use Security;
13
Security::count_hits();
14
15
use Bc_misc qw(get_param);
16
use Bc_sql qw(
17
get_constant
18
get_error
19
sql_execute
20
user_exists
21
$QUERY_PAGE
22
$QUERY_UID
23
$LOGGEDIN
24
25
$DB
26
);
27
28
my $email = get_param("e");
29
$email =~ s/(\!|\#|\$|\%|\&|\'|\*|\+|\/|\=|\?|\^|\_|\`|\{|\||\}|\~)/\\$1/g;
30
31
my $usable = 1; # assume the email address is valid, even if it isn't
32
# as well go through the process, $usuable will be changed to 0 if we
33
# encounter a problem with the email address being unique and/or valid
34
35
my $DEBUG = 0;
36
37
print "cache-control: no-cache, no-store\ncontent-type: text/plain\n\n";
38
39
# this wass removed, as it can reveal a user with that email
40
# address exists, and that's not good for someone trying to stay
41
# "below the radar".
42
#if ($email) {
43
# my $sql = sql_execute("select email from users where email like " . $DB->quote($email), "verifyemail.pl");
44
# if (ref $sql eq "HASH") {
45
# $usable = 0;
46
# } elsif (ref $sql eq "ARRAY") {
47
# if (@$sql) { $usable = 0; }
48
# }
49
#} else {
50
# $usable = get_error("DATA_INVALID");
51
#}
52
53
# now, check to make sure the email is actually valid
54
if ($usable) {
55
# email addresses already in DB don't need verification...duh
56
# we're just gonna make sure there's only ONE @ symbol, and at least one dot
57
# first, let's split the address up at the @
58
my @addy = split(/\@/, $email);
59
60
# it should only be two pieces
61
if (@addy != 2) {
62
$usable = get_error("MAILER_INVALID_PART_COUNT");
63
} else {
64
# okay, so it's got two bits.
65
# now see if the first bit (the local bit) is 64 chars or less
66
if (length $addy[0] > 64) {
67
$usable = get_error("MAILER_LOCAL_TOO_LONG");
68
}
69
# now see if the first bit (the local bit) is 64 chars or less
70
elsif (length $addy[1] > 255) {
71
$usable = get_error("MAILER_DOMAIN_TOO_LONG");
72
}
73
# now check for double . and leading/trailing dots in both parts of addy
74
elsif ($addy[0] =~ /\.(\.)+/ or $addy[1] =~ /\.(\.)+/ or
75
$addy[0] =~ /^\./ or $addy[1] =~ /^\./ or
76
$addy[0] =~ /\.$/ or $addy[1] =~ /\.$/ or
77
$addy[1] !~ /\./) {
78
$usable = get_error("MAILER_INVALIDCHAR");
79
} else {
80
# now, we gotta make sure only valid characters
81
# are in both parts
82
# first, we'll start with the stuff before @
83
# and then work on the stuff after
84
85
# let's do this differently.
86
# remove all valid characters from the email address.
87
# whatever's left over is invalid, unless it's blank!
88
# we want these to be blank
89
my $addy1 = $addy[0];
90
my $addy2 = $addy[1];
91
92
$addy1 =~ s/[a-z]//ig;
93
$addy1 =~ s/[0-9]//ig;
94
$addy1 =~ s/\\\!|\\\#|\\\$|\\\%|\\\&|\\\*|\\\+|\\\-|\\\/|\\\=|\\\?|\\\^|\\\_|\\\`|\\\{|\\\||\\\}|\\\~|\\'//g; # ' <-- here to terminate the first quote!
95
$addy1 =~ s/\.//g;
96
97
if ($addy2 =~ /^-/ or $addy2 =~ /-$/) { ; } else { $addy2 =~ s/-//g; }
98
$addy2 =~ s/[a-z]//ig;
99
$addy2 =~ s/[0-9]//ig;
100
$addy2 =~ s/\.//g;
101
102
if ($addy1 or $addy2) { $usable = get_error("MAILER_INVALIDCHAR"); }
103
}
104
}
105
}
106
107
my $nohtml = HTML::Restrict->new();
108
my $email_processed = $nohtml->process($email);
109
if ($email_processed ne $email) { $usable = get_error("MAILER_INVALIDCHAR"); }
110
111
if ($DEBUG) {
112
print "usable = " . $usable . "\n";
113
print "email provided = $email\n";
114
} else {
115
print $usable;
116
}
117
118
exit 1;