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
|
#!/usr/bin/perl -Tw
#
# $Id: register.cgi,v 1.5 2000-03-03 18:22:42 ivan Exp $
use strict;
use vars qw(
$datasrc $user $pass $x
$cgi $username $email
$dbh $sth
);
#$freeside_bin $freeside_test $freeside_conf
#@pw_set @saltset
#$user_pw $crypt_pw
#$header $msg
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use DBI;
#use Mail::Internet;
#use Mail::Header;
#use Date::Format;
$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
$ENV{'SHELL'} = '/bin/sh';
$ENV{'IFS'} = " \t\n";
$ENV{'CDPATH'} = '';
$ENV{'ENV'} = '';
$ENV{'BASH_ENV'} = '';
#$freeside_bin = '/home/freeside/bin/';
#$freeside_test = '/home/freeside/test/';
#$freeside_conf = '/usr/local/etc/freeside/';
$datasrc = 'DBI:mysql:http_auth';
$user = "freeside";
$pass = "maelcolm";
##my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
##my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9' );
#@pw_set = ( 'a'..'z', '0'..'9' );
#@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
###
$cgi = new CGI;
$username = $cgi->param('username');
$username =~ /^\s*([a-z][\w]{0,15})\s*$/i
or &idiot("Illegal username. Please use 1-16 alphanumeric characters, and start your username with a letter.");
$username = lc($1);
$email = $cgi->param('email');
$email =~ /^([\w\-\.\+]+\@[\w\-\.]+)$/
or &idiot("Illegal email address.");
$email = $1;
###
#$user_pw = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
#$crypt_pw = crypt($user_pw,$saltset[int(rand(64))].$saltset[int(rand(64))]);
###
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
###
$dbh = DBI->connect( $datasrc, $user, $pass, {
'AutoCommit' => 'true',
} ) or die "DBI->connect error: $DBI::errstr\n";
$x = $DBI::errstr; #silly; to avoid "used only once" warning
$sth = $dbh->prepare("INSERT INTO mysql_auth VALUES (". join(", ",
$dbh->quote($username),
# $dbh->quote("X"),
# $dbh->quote($crypt_pw),
$dbh->quote($email),
$dbh->quote('freeside'),
$dbh->quote('unconfigured'),
). ")" );
$sth->execute or &idiot("Username in use: ". $sth->errstr);
$dbh->disconnect or die $dbh->errstr;
###
$|=1;
print $cgi->header;
print <<END;
<HTML>
<HEAD>
<TITLE>Freeside demo registration successful</TITLE>
</HEAD>
<BODY BGCOLOR="#FFFFFF">
<table>
<tr><td>
<p align=center>
<img border=0 alt="Silicon Interactive Software Design" src="http://www.sisd.com/freeside/small-logo.gif">
</td><td>
<center><font color="#ff0000" size=7>freeside demo registration successful</font></center>
</td></tr>
</table>
<P>Your sample database has been setup. Your password and the URL for the
Freeside demo have been emailed to you.
</BODY>
</HTML>
END
###
sub idiot {
my($error)=@_;
print $cgi->header, <<END;
<HTML>
<HEAD>
<TITLE>Registration error</TITLE>
</HEAD>
<BODY BGCOLOR="#FFFFFF">
<CENTER>
<H4>Registration error</H4>
</CENTER>
<P><B>$error</B>
<P>Hit the <I>Back</I> button in your web browser, correct this mistake,
and submit the form again.
</BODY>
</HTML>
END
exit;
}
|
