fs_webdemo/register.cgi

   1 #!/usr/bin/perl -Tw
   2 #
   3 # $Id: register.cgi,v 1.2 2000-03-01 08:15:10 ivan Exp $
   4
   5 use strict;
   6 use vars qw( #$freeside_bin $freeside_test $freeside_conf
   7              $datasrc $user $pass $x
   8              #@pw_set @saltset
   9              $cgi $username $email
  10              #$user_pw $crypt_pw
  11              $dbh $sth
  12              #$header $msg
  13              );
  14 use CGI;
  15 #use CGI::Carp qw(fatalsToBrowser);
  16 use DBI;
  17 #use Mail::Internet;
  18 #use Mail::Header;
  19 #use Date::Format;
  20
  21 $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
  22 $ENV{'SHELL'} = '/bin/sh';
  23 $ENV{'IFS'} = " \t\n";
  24 $ENV{'CDPATH'} = '';
  25 $ENV{'ENV'} = '';
  26 $ENV{'BASH_ENV'} = '';
  27
  28 #$freeside_bin = '/home/freeside/bin/';
  29 #$freeside_test = '/home/freeside/test/';
  30 #$freeside_conf = '/usr/local/etc/freeside/';
  31
  32 $datasrc = 'DBI:mysql:http_auth';
  33 $user = "freeside";
  34 $pass = "maelcolm";
  35
  36 ##my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
  37 ##my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9' );
  38 #@pw_set = ( 'a'..'z', '0'..'9' );
  39 #@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
  40
  41 ###
  42
  43 $cgi = new CGI;
  44
  45 $username = $cgi->param('username');
  46 $username =~ /^\s*([a-z][\w]{0,15})\s*$/i
  47   or &idiot("Illegal username.  Please use 1-16 alphanumeric characters, and start your username with a letter.");
  48 $username = lc($1);
  49
  50 $email = $cgi->param('email');
  51 $email =~ /^([\w\-\.\+]+\@[\w\-\.]+)$/
  52   or &idiot("Illegal email address.");
  53 $email = $1;
  54
  55 ###
  56
  57 #$user_pw = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
  58 #$crypt_pw = crypt($user_pw,$saltset[int(rand(64))].$saltset[int(rand(64))]);
  59
  60 ###
  61
  62   local $SIG{HUP} = 'IGNORE';
  63   local $SIG{INT} = 'IGNORE';
  64   local $SIG{QUIT} = 'IGNORE';
  65   local $SIG{TERM} = 'IGNORE';
  66   local $SIG{TSTP} = 'IGNORE';
  67   local $SIG{PIPE} = 'IGNORE';
  68
  69 ###
  70
  71 $dbh = DBI->connect( $datasrc, $user, $pass, {
  72         'AutoCommit' => 'true',
  73 } ) or die "DBI->connect error: $DBI::errstr\n";
  74 $x = $DBI::errstr; #silly; to avoid "used only once" warning
  75
  76 $sth = $dbh->prepare("INSERT INTO mysql_auth VALUES (". join(", ",
  77   $dbh->quote($username),
  78   $dbh->quote("X"),
  79 #  $dbh->quote($crypt_pw),
  80   $dbh->quote('freeside'),
  81   $dbh->quote('unconfigured'),
  82 ). ")" );
  83
  84 $sth->execute or &idiot("Username in use: ". $sth->errstr);
  85
  86 $dbh->disconnect or die $dbh->errstr;
  87
  88 ###
  89
  90 $|=1;
  91 print $cgi->header;
  92 print <<END;
  93 <HTML>
  94   <HEAD>
  95     <TITLE>Freeside demo registration successful</TITLE>
  96   </HEAD>
  97   <BODY BGCOLOR="#FFFFFF">
  98   <table>
  99     <tr><td>
 100     <p align=center>
 101       <img border=0 alt="Silicon Interactive Software Design" src="http://www.sisd.com/freeside/small-logo.gif">
 102     </td><td>
 103     <center><font color="#ff0000" size=7>freeside demo registration successful</font></center>
 104     </td></tr>
 105   </table>
 106   <P>Your sample database has been setup.  Your password and the URL for the
 107     Freeside demo have been emailed to you.
 108   </BODY>
 109 </HTML>
 110 END
 111
 112 ###
 113
 114 sub idiot {
 115   my($error)=@_;
 116   print $cgi->header, <<END;
 117 <HTML>
 118   <HEAD>
 119     <TITLE>Registration error</TITLE>
 120   </HEAD>
 121   <BODY BGCOLOR="#FFFFFF">
 122     <CENTER>
 123     <H4>Registration error</H4>
 124     </CENTER>
 125     <P><B>$error</B>
 126     <P>Hit the <I>Back</I> button in your web browser, correct this mistake,
 127        and submit the form again.
 128   </BODY>
 129 </HTML>
 130 END
 131
 132   exit;
 133
 134 }