Expand|Select|Wrap|Line Numbers
- use strict;
- use CGI qw(:standard);
- use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
- use DBI;
- $CGI::POST_MAX = 1024 * 1000;
- sub print_login_form($);
- my $dbh = DBI->connect('DBI:mysql:users:localhost', 'root', '', {
- RaiseError => 1,
- AutoCommit => 1
- }) or &dieNice("Can't connect to database:$DBI::errstr");
- my $username = param('username');
- my $password = param('password');
- my $data = $dbh->prepare("select * from users where username=?") or &dbdie;
- $data->execute($username) or &dbdie;
- my $uinfo = $data->fetchrow_hashref;
- unless (param("filled")) {
- print_login_form("");
- exit;
- }
- # Error Checking
- dieNice("Please enter your Username") if !defined $username;
- dieNice("Please enter your Password") if !defined $password;
- dieNice("The username $username does not exist.") if $username ne $uinfo->{username};
- dieNice("Incorrect password") if $password ne $uinfo->{password};
- # Successful Match
- print redirect(- location=>"upload.html");
- sub print_login_form($) {
- print <<END1;
- <HTML>
- <HEAD>
- <TITLE> Media File Upload/Search System</TITLE>
- </HEAD>
- <body bgcolor="#003366">
- <form ACTION="cgi-bin/login.cgi" METHOD="POST">
- <img src="unilogo.gif" border=0> </img>
- <font color="yellow"><h1>Media File Upload/Search System</h1></font>
- <font color="white"><h3>Sign into File Upload/Search System</h3></font>
- <TABLE>
- <TR>
- <TD ALIGN="right"><font color="white"><STRONG>Username:</STRONG><font></TD>
- <TD><INPUT TYPE="text" SIZE=30 NAME="username"></TD>
- </TR>
- <TR>
- <TD ALIGN="right"><font color="white"><STRONG>Password:</STRONG><font></TD>
- <TD><INPUT TYPE="password" SIZE=30 NAME="password"></TD>
- </TR>
- </TABLE>
- <style>
- .box{
- margin-left: 165px;
- }
- </style>
- <TABLE class=box>
- <TR>
- <TD>
- <a href=newuser.html><FONT color=c0c0c0 ><strong>New User</font></a>
- <input type="submit" name="submit" value="Login">
- </TD>
- </TR>
- <TABLE>
- <TR>
- <TD ALIGN="left">
- <a href=deleteuser.html><FONT color=c0c0c0 ><strong>Don't like this service, Delete User</font></a>
- </TD>
- </TR>
- </TABLE>
- </FORM>
- </BODY>
- </HTML>
- END1
- }
- sub dieNice {
- my ($msg) = @_;
- print "<h2>Error</h2>\n";
- print $msg;
- exit;
- }
- sub dbdie {
- my ($package, $filename, $line) = caller;
- my $errmsg = "Database error: $DBI::errstr<br> called from $package $filename line $line";
- &dieNice($errmsg);
- }
- sub encrypt {
- my ($plain) = @_;
- my @salt = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/');
- return crypt($plain, $salt[int(rand(@salt))] . $salt[int(rand(@salt))]);
- }