Illx.org Secure Jabber Registration Form

#!/usr/local/bin/perl -w #NOTE, for some reason taintedness #screws up our reminder.. the Net::Jabber library #doesn't like it #the reguser part and notification part #taken from the O'Reilly Programming Jabber Book #Cleaned up and put to the web by me. #So, mostly written by me, Nick (see http://illx.org for more details) #on 2003-07-03 $ENV{'PATH'} = ''; use strict; use warnings; use CGI; use Net::Jabber 1.0022 qw(Client); use constant NS_REGISTER => 'jabber:iq:register'; my $q = new CGI; my $submit = $q->param('submit') || ''; if($submit eq 'signup') { #validate the input my @reqd_fields = qw(username password name email); foreach my $rf (@reqd_fields) { my $value = $q->param("$rf") || ''; if($value eq '') { content(1); } } $q->import_names('Q'); #check to make sure the email is valid use Email::Valid; my $r = Email::Valid->address("$Q::email"); if(!$r) { content(2); } #sign them up, notify the admin, and say thanks reg_user($Q::username,$Q::password,$Q::name,$Q::email); } else { content(); } sub content { my ($err,$error) = @_; print $q->header, qq~ Illx.org Secure Jabber Registration Form

~; print qq~ ~; if($err == 1) { print qq~~; #' } elsif($err == 2) { print qq~~; #' } elsif($err == 3) { print qq~~; } else { print qq~~; } print qq~ ~; exit 1; } sub thanks { print $q->header,$q->start_html, "Thank you for signing up to illx.org's jabber server

", "If you wish to chat with me, just add nonexist\@illx.org as a contact
", qq~Back to illx.org~; exit 1; } sub reg_user { my ($username,$password,$name,$email) = @_; my $c = Net::Jabber::Client->new(); defined($c->Connect( hostname => 'illx.org', port => '5222', )) or die "Cannot reach Jabber server at illx.org:5222\n"; my ($iq, $query, $result); $iq = Net::Jabber::IQ->new(); $iq->SetType('set'); $query = $iq->NewQuery(NS_REGISTER); $query->SetUsername($username); $query->SetPassword($password); $query->SetName($name); $query->SetEmail($email); $result = $c->SendAndReceiveWithID($iq); #Success if ($result->GetType() eq 'result') { #notify the jabber administrator send_reminder($username,$name,$email); #and give them the thanks page thanks(); } #Failure else { content(3, $result->GetErrorCode()." (".$result->GetError().")\n"); } $c->Disconnect; } #this sub-routine sends a notification #to me that tells me that someone has used #this script! :) #Please note, I tried using my own #jabber server to send the reminder and it #never worked.. I am using another jabber #account I have at jabber.com sub send_reminder { my ($username,$name,$email) = @_; #connect to some other jabber server my $c = new Net::Jabber::Client; $c->Connect('hostname' => 'jabber.com', 'port' => 5222) or die "Cannot reach Jabber server at jabber.com:5222\n"; #some other accout $c->AuthSend('username' => 'USERNAME', 'password' => 'PASSWORD', 'resource' => 'reminder'); #do all our presence stuff $c->SetCallBacks('presence' => \&handle_presence); $c->PresenceSend(); $c->Process(5); #Create a new message with our reminder text my $body = "A new user '$username' named '$name' with email '$email' has signed up to our jabber server"; my $m = new Net::Jabber::Message; $m->SetMessage(To=>'nonexist@illx.org', Subject=>'Notification', Body=>$body, Type=>'chat'); #send the message $c->Send($m); #Disconnect from the Jabber server and exit $c->Disconnect; } # Deal with presence packets sub handle_presence { my ($sid, $presence) = @_; }

Error! you didn't fill out fields.
Error! The email address you filled in isn't valid /td>
$error

Jabber User Registration for illx.org
Note, this form is secure.
Please note: All fields are required.

user name:	~,$q->textfield(-name=>'username'),qq~\@illx.org
Note, your new jabber ID will be your username\@illx.org
password:	~,$q->password_field(-name=>'password'),qq~
name:	~,$q->textfield(-name=>'name'),qq~
email address:	~,$q->textfield(-name=>'email'),qq~

~,$q->submit(-name=>'Submit',-value=>'Sign Up for illx.org Jabber Account'),qq~