Listing 2: Perl XML-RPC Listener
<![if !supportEmptyParas]> <![endif]>
1 #!/usr/bin/perl --
2 # XML-RPC listener that brokers account request
3
4 use strict;
5 use warnings;
6 use Frontier::Daemon;
7 use DBI;
8
9 # Start a global connection to mysql
10 my $Dbh = DBI->connect('dbi:mysql:accounts:marian.daisypark.net', 'web', '');
11 unless( defined $Dbh ){
12 die "ERROR: Can't connect to mysql database on marian";
13 }
14
15 Frontier::Daemon->new(
16 methods => {
17 authenticate => \&authenticate,
18 get_account_info => \&get_account_info,
19 set_account_info => \&set_account_info,
20 },
21 LocalHost => 'marian.daisypark.net',
22 LocalPort => 1080, 23 );
24
25 sub END {
26 if( defined $Dbh ){
27 $Dbh->do("Unlock Tables");
28 $Dbh->disconnect;
29 }
30 }
31
32 #---------------------------------
33 # Remote procedure implementation
34 #---------------------------------
35
36 sub authenticate {
37 my ($username, $password) = @_;
38
39 die "Please supply a valid password" unless validate_password($password);
40 die "Please supply a valid username" unless validate_username($username);
41
42 # Ok to proceed
43 my $enc_password;
44 my $sth = $Dbh->prepare("Select password From users Where username=?"); 45 die "Oops! no statement handle" unless $sth;
46
47 $sth->execute( $username );
48 $sth->bind_col(1,\$enc_password);
49 $sth->fetch;
50
51 if( ! defined $enc_password ){
52 die "Couldn't fetch password for '$username'";
53 }
54
55 # This password is DES encrypted
56 my $in = crypt( $password, substr($enc_password, 0, 2) );
57 if( $enc_password eq $in ){
58 logger( $username, 'LOGIN');
59 return new_session_id($username);
60 }else{
61 return 0;
62 }
63
64 }
65 66 sub get_account_info {
67 my ($sid) = @_;
68
69 die "Please supply a positive integer greater than 0" if $sid < 1; 70
71 my $sth = $Dbh->prepare(<<EOT);
72 Select users.username,fullname,points From sessions
73 Left Join users On sessions.username = users.username
74 Where sessions.id = ?
75 EOT
76
77 unless( $sth ){
78 warn "\$sth in get_account_info failed\n";
79 }
80
81 $sth->execute($sid) || die "Error: ". $sth->errstr();
82
83 my $hr = $sth->fetchrow_hashref; # should only be one
84 unless( ref $hr ){
85 warn "Couldn't find any rows for SID=$sid'";
86 return {}
87 }
88 return $hr;
89 }
90
91 sub set_account_info {
92 my ($user_rec) = @_;
93 my %user_rec = %{$user_rec};
94
95 # Make sure everything seems normal
96 unless(validate_username($user_rec{username})){
97 die "Username must be less than 13 characters(not $user_rec{username})";
98 }
99
100 # this number will overflow mysql table (signed int)
101 $user_rec{points} = $user_rec{points} % 2_000_000_000;
102
103 unless( $Dbh->do("Lock Tables users WRITE") ){
104 die "Couldn't lock users table!";
105 }
106
107 # Could be an update
108 my $count = $Dbh->do("select * from users where username=".
109 $Dbh->quote($user_rec{username}) );
110
111 # Sanity check, $count > 1 is an error!
112 if( $count > 0){
113 # This is an update (no password update!)
114 my $sth = $Dbh->prepare(<<EOT);
115 Update users set fullname=?,points=?
116 where username=?
117 EOT
118 # lock the table during the update
119 my $rc = $sth->execute(@user_rec{
120 'fullname',
121 'points'
122 }, $user_rec{username}
123 );
124
125 $Dbh->do("Unlock Tables");
126 logger( $user_rec{username}, 'UPDATED USERINFO');
127
128 if($rc){
129 return 1;
130 }else{
131 return 0;
132 }
133
134 }else{
135 # This is a new user, don't need tables locked for this
136 $Dbh->do("Unlock Tables");
137 logger( $user_rec{username}, 'ADDED USER');
138
139 # Encrypt the plain text password
140 my $salt = join '', ("a".."z")[ rand(26), rand(26) ];
141 $user_rec{password} = crypt($user_rec{password}, $salt);
142
143
144 my $sth = $Dbh->prepare(<<EOT);
145 Insert into users (username,password,fullname,points) VALUES (?,?,?,?) 146 EOT
147 if( $sth->execute(
148 @user_rec{'username', 149 'password',
150 'fullname',
151 'points'
152 }
153 )){
154 return 1;
155 }else{
156 return 0;
157 }
158 }
159 }
160
161 #--------------------------
162 # Helper Functions
163 #--------------------------
164 sub validate_username {
165 my ($usr) = @_;
166
167 if( ! defined $usr || length($usr) > 12){
168 return 0;
169 }else{
170 return 1;
171 }
172 }
173
174 sub validate_password {
175 my ($pass) = @_;
176 if( ! defined $pass || length($pass) > 13 ) {
177 return 0;
178 }else{
179 return 1;
180 }
181 }
182
183 sub validate_fullname {
184 my ($fullname) = @_;
185
186 if( ! defined $fullname || length($fullname) > 50 ){
187 return 0;
188 }else{
189 return 1;
190 }
191 }
192
193 sub logger {
194 my ($username, $action) = @_;
195
196 return unless validate_username( $username );
197 return if length($action) > 25;
198 my $sth = $Dbh->prepare("insert into logins (username,action) VALUES (?,?)");
199 unless( $sth ){
200 warn "Prepare failed: ", $Dbh->errstr();
201 return;
202 }
203 unless( $sth->execute( $username, $action ) ){
204 warn "execute failed: ", $sth->errstr();
205 return;
206 }
207 return 1;
208 }
209
210 sub new_session_id {
211 my ($username) = @_; # Already should have check for valid username 212
213 my $sth = $Dbh->prepare("Insert into sessions (username) VALUES (?)"); 214 $sth->execute($username);
215
216 return $Dbh->{mysql_insertid};
217 }
|