Foro - Perl en Español

#!/usr/bin/perl
#########################################################################
#  Guestbook v1.51                                                      #
#  Copyright (c)2000 Chi Kien Uong                                      #
#  URL: http://www.proxy2.de                                            #
#                                                                       #
# This Software is distributed under the GNU General Public             #
# License. For more details see license.txt                             #
#                                                                       #
# Administration:                                                       #
# http://www.host.com/cgi-bin/guestbook.pl?admin=enter                  #
#                                                                       #
# For more stuff visit --> http://www.proxy2.de                         #
#########################################################################

# url of script
$cgiurl = "http://localhost/cgi-bin/guestbook.pl";

# administration password
$admin_pass = "123";

# base url to all guestbook files without trailing "/"
$bookurl = "http://localhost/book";

# base directory to all guestbook files from the server root without trailing "/"
$base_dir = "/home/usr/you/book";

# guestbook entries per page;
$entries = 20;

# use file locking; ($lock=0 for Win32)
$lock = 1;

# allow html tags - 0=no; 1=yes; 2=translate
$html_tags = "2";

# time to redirect to guestbook after entry
$redirect_sec = "3";

# time offset - add one hour = +1 ; subtract one hour = -1
$fix_time = 0;

# entry bgcolor
$entry_bg = "#EFEFEF";
$font_face = "Verdana, Arial";

# name of guestbook files
$book_file = "guestbook.html";
$id_count = "guest_id.txt";
$page_count = "page_id.txt";
$sample = "template.html";

# name of thread pages -> guest-1.html, guest-2.html, etc.
$sub_page = "guest-";

# this variable is used to find the jump menu
$jump_menu = "<option value=\"guestbook.html\" selected>Guestbook</option>";

# image files
$arrow_img = "point.gif"; # if not in same dir with guestbook.html
$mail_img = "mail.gif";   # specify correct url for each file
$url_img = "url.gif";

# Send the new guestbook-entry as email to recipient
$notification = "no";
$mailprog = "/usr/sbin/sendmail"; # path to sendmail
$recipient = "you\@yourdomain.com";    # your email address

%required = (
       
        username        => "yes",
        email           => "no",
        url             => "no",
        message         => "yes"

);
$remove_bad_words = "yes";
@bad_words = ("fuck","cum","asshole","ficken","Arsch","porno");

# End of Setup
##################

&parse_form;

if ($FORM{'add'} eq "new") {

        &check_input;
        &check_words if ($remove_bad_words eq "yes");  
        &add_entry;
        &error("Cannot add entry to guestbook because the comment <br>&lt!--begin --&gt was not found in $book_file") if ($succes != 1);
        &send_mail if ($notification eq "yes");
        &success;
}
elsif ($FORM{'admin'} eq "enter") {

        &validation;
}
elsif ($FORM{'action'} eq "delete") {
        if ($FORM{'admin'} eq $admin_pass) {
                &delete_entry;
                &show_entries;
        }
        else {
                &error('You entered a wrong password!');
        }
}
elsif ($FORM{'action'} eq "show") {
        if ($FORM{'admin'} eq $admin_pass) {
                &show_entries;
        }
        else {
                &error('You entered a wrong password!');
        }
}
else {
        &error('No Valid Command!');
}

sub parse_form {

if ($ENV{'REQUEST_METHOD'} eq "GET") {
        $buffer = $ENV{'QUERY_STRING'};
}
else {
        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}
@pairs = split(/&/, $buffer);
foreach $pair (@pairs) {       
        ($name, $value) = split(/=/, $pair);
        $name =~ tr/+/ /;
        $name =~ s/%([a-f0-9]{2})/pack("C", hex($1))/egi;
        $value =~ tr/+/ /;
        $value =~ s/%([a-f0-9]{2})/pack("C", hex($1))/egi;
        $value =~ s/<!--(.|\n)*-->//g;
        $value =~ s/^\s+|\s*\n$//g;
        $value =~ s/ +/ /g;
        if ($html_tags eq "0") {
                $value =~ s/<([^>]|\n)*>//g;
                $value =~ s/<([^>]|\n)*//g;
        }
        elsif ($html_tags eq "2") {
                $value =~ s/\"/\&quot\;/g;
                $value =~ s/</\&lt\;/g;
                $value =~ s/>/\&gt\;/g;
        }
        $FORM{$name} = $value;
}
}
sub check_input {

        my($username,$usermail,$userurl,$usermessage);
        $username = $FORM{'username'};
        $usermail = $FORM{'email'};
        $userurl = $FORM{'url'};
        $FORM{'message'} =~ s/\cM\n/<br>\n/g;
        $usermessage = $FORM{'message'};
        if ($username !~ /\S/) {
                if ($required{'username'} eq "yes") {
                        &error('You forgot to fill in the <u>Name</u> field. Please correct it and re-submit!');
                }
                $FORM{'username'} = "anonymous";
        }
        if ($usermail !~ /[._a-z0-9-]+\@[._a-z0-9-]+\.[a-z]{2,3}$/i) {
                if ($required{'email'} eq "yes") {
                        &error('The <u>e-mail</u> address seems not to be valid. Please correct it and re-submit!');
                }
                $FORM{'email'} = "";
        }
        if ($userurl !~ /^http:\/\/[._a-z0-9-]+\.[._a-z0-9-]+/i) {
                if ($required{'url'} eq "yes") {
                        &error('The <u>URL</u> seems not to be valid. Please correct it and re-submit!');
                }
                $FORM{'url'} = "";
        }
        if ($usermessage !~ /\S/) {
                if ($required{'message'} eq "yes") {
                        &error('You forgot to fill in the <u>Message</u> field. Please correct it and re-submit!');
                }
                $FORM{'message'} = "No Comments";
        }
}

sub check_words {
       
        foreach $word (@bad_words) {
                        $FORM{'username'} =~ s/\b$word\b/\#\@\*\%\!/ig;
                        $FORM{'message'} =~ s/\b$word\b/\#\@\*\%\!/ig;
        }
}

sub get_host {
        my ($ip_address,$ip_number,@numbers);
        if ($ENV{'REMOTE_HOST'}) {
                $host = $ENV{'REMOTE_HOST'};
        }
        else {
                $ip_address = $ENV{'REMOTE_ADDR'};
                @numbers = split(/\./, $ip_address);
                $ip_number = pack("C4", @numbers);
                $host = (gethostbyaddr($ip_number, 2))[0];
        }
        if ($host eq "") {
                $host = "IP\: $ENV{'REMOTE_ADDR'}";
        }
        else {
                $host = "Host\: $host";
        }
}

sub get_time {
my ($min,$hour,$mday,$mon,$year,$wday,@month,@days);
@months = ('January','February','March','April','May','June','July','August','September','October','November','December');
@days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');

($min,$hour,$mday,$mon,$year,$wday) = (localtime(time+($fix_time*3600)))[1,2,3,4,5,6];
$min = "0$min" if ($min < 10);
$hour = "0$hour" if ($hour < 10);
$mday = "0$mday" if ($mday < 10);
$year += 1900;
$this_day = ("$days[$wday], $months[$mon] $mday, $year at $hour:$min");
}

sub add_entry {
my ($remain,$entry_id,$page_num,$page_val,$num_min,$num_max,@lines,@filename,@foundlist,@booklines,@pages_id,@sublines);
&get_host;
&get_time;
if (-e "$base_dir/$id_count") {
        open (COUNTER,"+<$base_dir/$id_count") || &error("Cannot open ID file $id_count in $base_dir for writing!");
        $entry_id = <COUNTER>;
}
else { 
        open (COUNTER,">$base_dir/$id_count") || &error("Cannot create ID file $id_count in $base_dir. Please check your base directory.","fatal");
        $entry_id =1;
}
close(COUNTER);

if (-e "$base_dir/$page_count") {
        open (PAGES,"+<$base_dir/$page_count") || &error("Cannot open ID file $page_count in $base_dir for writing!");
        @pages_id = <PAGES>;
        if ($pages_id[0] =~ /<option.*-(\d+)<\/option>/) {
                $last_entry = $1;
                $total_pages = @pages_id;
        }
        else {
                $last_entry = 0;
        }
}
else { 
        open (PAGES,">$base_dir/$page_count") || &error("Cannot create ID file $page_count in $base_dir. Please check your base directory.","fatal");
        $last_entry = 0;
}
close(PAGES);

$remain = $entry_id - ($last_entry + $entries);
if ($remain > 1) {
        $remain2 = $entry_id % $entries if ($entry_id > $entries);
        $remain = 1 if ($remain2 == 1);
}
if ($remain == 1) {
        $page_num = $total_pages + 1;
        $num_min = $last_entry + 1;
        $num_max = $entry_id-$remain;
        $page_val = "<option value=\"$bookurl/$sub_page$page_num\.html\">$num_min-$num_max</option>";
               
        open(FILE,"$base_dir/$book_file");
        @lines = <FILE>;
        close(FILE);
       
        open(FILE,">$base_dir/$sub_page$page_num\.html") || &error("Cannot create files in $base_dir. Chmod $base_dir to 777!");
        print FILE (@lines);
        close(FILE);

        opendir(HOMEDIR, "$base_dir");
        @filename = readdir(HOMEDIR);
        closedir(HOMEDIR);
       
        @foundlist = grep(/^$sub_page\d+/, @filename);
        if (-e "$base_dir/$sample") {
                push (@foundlist,"$sample");
        }
        else {
                &error("Cannot find sample file $sample in $base_dir");
        }
        foreach $bookpage (@foundlist) {
                open(SUBPAGE,"$base_dir/$bookpage");
                @tmp_lines = <SUBPAGE>;
                close(SUBPAGE);
                if ($bookpage eq "$sample") {
                        open(SUBPAGE,">$base_dir/tmp.html");
                        $flag = 1;
                }
                else {
                        open(SUBPAGE,">$base_dir/$bookpage");
                }
                foreach $line (@tmp_lines) {
                        if ($line =~ /^.*$jump_menu.*/) {
                                ($part1, $part2) = split(/$jump_menu\s*/,$line);
                                print SUBPAGE "$part1";
                                print SUBPAGE "$jump_menu\n";
                                print SUBPAGE "$page_val\n";
                                print SUBPAGE (@pages_id) if ($flag ==1);
                                print SUBPAGE "$part2";
                                $thread = 1;
                                $flag = 0;
                        }
                        else {
                                print SUBPAGE "$line";
                        }
                }
                close(SUBPAGE);
                &error("Cannot add entry to guestbook because the html tag <br><xmp>$jump_menu</xmp> was not found in some guestbook files.") if ($thread != 1);
                $thread = 0;
        }
        open (PAGES,"+<$base_dir/$page_count");
        @sublines = <PAGES>;
        seek(PAGES,0,0);
        print PAGES "$page_val\n";
        print PAGES (@sublines);
        close(PAGES);
        open(FILE,"$base_dir/tmp.html") || &error("Internal error!<br>Cannot open tmp.html in $base_dir");
}
else {
        open(FILE,"$base_dir/$book_file") || &error("Cannot find $book_file in $base_dir");
}
@booklines = <FILE>;
close(FILE);

open(FILE,">$base_dir/$book_file") || &error("The directory $base_dir requires mode 777!");
flock(FILE,2) if ($lock == 1);
   foreach $line (@booklines) {
      if ($line =~ /^.*<!--begin -->.*/) {
         ($part1, $part2) = split(/<!--begin -->\s*/,$line);
         print FILE "$part1";
         print FILE "<!--begin -->\n";
         print FILE "<!--top-ID=$entry_id -->\n";
         print FILE "<tr bgcolor=\"$entry_bg\"><td width=\"32%\">\n<table border=0 cellspacing=0 cellpadding=2>\n";
         print FILE "<tr><td><font face=\"$font_face\" size=1>$entry_id)</font></td>\n";
         print FILE "<td><b><font face=\"$font_face\" size=2>$FORM{'username'}</font></b></td></tr>";
         if ($FORM{'email'}) {
            print FILE "<tr><td><img src=\"$mail_img\" width=20 height=17></td>\n";
            print FILE "<td><font face=\"$font_face\" size=1><a href=\"mailto:$FORM{'email'}\">$FORM{'email'}</a></font></td></tr>\n";    
         }      
         if ($FORM{'url'}) {
            print FILE "<tr><td><img src=\"$url_img\" width=20 height=20></td>\n";
            print FILE "<td><font face=\"$font_face\" size=1><a href=\"$FORM{'url'}\" target=\"_blank\">$FORM{'url'}</a></font></td></tr>\n";  
         }
         print FILE "</table>\n</td><td width=\"68%\"><font face=\"$font_face\" size=2>\n";
         print FILE "$FORM{'message'}</font><hr size=1>\n";
         print FILE "<font face=\"Arial\" size=\"1\"><img src=\"$arrow_img\" width=9 height=9><b>$this_day $host</b></font></td></tr>\n";
         print FILE "<!--end-ID=$entry_id -->\n";
         print FILE "$part2";
         $succes = 1;
      }
      else {
         print FILE "$line";
      }
   }
close(FILE);
unlink("$base_dir/tmp.html") if ($remain == 1);
if ($succes == 1) {
        open (COUNTER,">$base_dir/$id_count");
        flock(COUNTER,2) if ($lock == 1) ;
        $entry_id ++;
        print COUNTER "$entry_id";
        close(COUNTER);
}

}

sub success {
print "Content-type: text/html\n\n";
print <<SuccessHTML;
<html>
<head>
<title>Guestbook</title>
<meta http-equiv="pragma" content="no-cache">
<meta http-equiv="refresh" content="$redirect_sec;URL=$bookurl/$book_file">
<style type="text/css">
<!--
td {  font-family: Verdana, Arial, Helvetica, sans-serif}
-->
</style>
</head>
<body bgcolor="#FFFFFF" text="#000000" link="#003399">
<table border="0" cellspacing="0" cellpadding="2" align="center" width="95%" height="156">
  <tr>
    <td height="46" colspan="2"><b><font size="4">Guestbook</font></b></td>
  </tr>
  <tr>
    <td colspan="2"><font size="2"><u>Thank you <font color="#990033">$FORM{'username'}</font>
      for signing the guestbook.<br>
      </u><br>
      Your entry was added successfully!<br>
      You should be transfered back to the guestbook in $redirect_sec seconds.<br>
      Click <a href="$bookurl/$book_file">here</a> if your browser does'nt support
      automatical reloading.</font></td>
  </tr>
</table>
</body>
</html>
SuccessHTML
exit (0);
}

sub validation {
       
        if ($FORM{'password'} eq $admin_pass) {
                &show_entries;
        }
        elsif ($FORM{'password'} eq "") {
                &enterpass('Please enter a valid password:');
        }
        else {
                &enterpass('<font color="#CC3300">You have entered an invalid password. Please try again.</font>');
        }
}

sub show_entries {

my ($entry_num,$found,@filename,@foundlist);
unless (@lines >0) {
        if ($FORM{'page'} !~ /$sub_page\d+\.html/) {
                open(FILE,"$base_dir/$book_file");
                $FORM{'page'} = $book_file;
        }
        else {
                open(FILE,"$base_dir/$FORM{'page'}");
        }
        @lines = <FILE>;
        close(FILE);
}
print "Content-type: text/html\n\n";
print <<Header;
<html>
<head>
<title>Administration</title>
<base href="$bookurl/">
<style type="text/css">
<!--
td {  font-family: Verdana, Arial, Helvetica, sans-serif}
-->
</style>
<script language="Javascript">
<!--
function CheckForm() {
 var found = 0;
 if(document.guest.admin.value == "") {
    alert("Please enter a password!");
    document.guest.admin.focus();
    return false;
 }
 if(!(document.guest.action.value == 'delete' || document.guest.action.value == 'show')) {
    alert("Invalid command!");
    return false;
 }
 if(document.guest.action.value == 'delete') {
  id_val=document.guest.entry.value;
  for (char_pos=0; char_pos<id_val.length; char_pos++) {
       if (!(id_val.charAt(char_pos) >= '0' && id_val.charAt(char_pos) <= '9')) {
          found = 1;
       }
  }
  if (found == 0) {
     return true;
  } else {
     alert("Wrong ID!");
     return false;
  }
 }
}
function SetValue(id) {
 document.guest.entry.value = id;
 document.guest.action.value = 'delete';
}
function JumpTo(page) {
   document.guest.page.value = page.menu.options[page.menu.selectedIndex].value;
   document.guest.action.value = 'show';
   document.guest.entry.value = "";
}
// -->
</script>
</head>
<body bgcolor="#DDDDDD" link="#003399">
<div align=center><font size="4" face="Verdana, Arial, Helvetica, sans-serif"><b>Administration</b></font></div>
<form method="post" action="$cgiurl" name="guest">
<table width="97%" border="0" cellspacing="0" cellpadding="3" bgcolor="#FFFFFF" align="center">
    <tr bgcolor="#BCBCDE">
      <td colspan="2">
        <hr size="1">
        <table border="0" cellspacing="0" cellpadding="4" align="center">
          <tr>
            <td><font size="1">Selected page:<br>
              <input type="text" name="page" value="$FORM{'page'}" size="12"></font></td>
            <td><font size="1">Action:<br>
              <input type="text" name="action" size="6"></font></td>
            <td><font size="1">Entry ID:<br>
              <input type="text" name="entry" size="6"></font></td>
            <td><font size="1">Password:<br>
              <input type="password" name="admin" size="10">
              <input type="submit" value="Submit" onclick="return CheckForm();">
              <input type="reset" value="Reset"></font></td>
            <td><font size="1">Jump to page:<br>
Header
opendir(HOMEDIR, "$base_dir");
@filename = readdir(HOMEDIR);
closedir(HOMEDIR);
@foundlist = grep(/^$sub_page\d+/, @filename);

print "        <select name=menu onChange=\"JumpTo(this.form)\">\n          <option value=\"$book_file\" selected>Guestbook</option>\n";
foreach $option (@foundlist) {
        print "          <option value=\"$option\">$option</option>\n";
}
print "        </select>\n        </font></td>\n";
print "     </tr>\n        </table>\n      <hr size=1>\n";
print "      <div align=right><img src=\"$arrow_img\" width=9 height=9><b><font size=1><a href=\"$bookurl/$book_file\">Back To Guestbook</a></font></b></div>\n    </td>\n  </tr>\n";
$entry_num=0;
$found=0;
foreach $line (@lines) {
        if ($line =~ /^.*<!--top-ID=(\d+) -->.*/ && $found==0) {
                $entry_num = $1;
                ($part1, $part2) = split(/<!--top-ID=$entry_num -->\s*/,$line);
                print "<tr><td><input type=radio name=\"id\" value=\"$entry_num\" onclick=\"SetValue('$entry_num');\"> <font size=2>ID: $entry_num</font></td><td>&nbsp;</td></tr>\n";
                print $part2 if($part2);
                $found=1;
                next;
        }
        elsif ($line =~ /^.*<!--end-ID=$entry_num -->.*/) {
                ($part3, $part4) = split(/<!--end-ID=$entry_num -->\s*/,$line);
                print $part3 if($part3);
                if ($part4 =~ /<!--top-ID=(\d+) -->.*/) {
                        $entry_num = $1;
                        ($part5,$part6) = split(/<!--top-ID=$entry_num -->\s*/,$part4);
                        print "<tr><td><input type=radio name=\"id\" value=\"$entry_num\" onclick=\"SetValue('$entry_num');\"> <font size=2>ID: $entry_num</font></td><td>&nbsp;</td></tr>\n";
                        print $part6 if($part6);
                        $found=1;
                        next;
                }
                $entry_num=0;
                $found=0;
                next;
        }
        elsif ($found==1) {
                print $line;
        }
}
print "</table>\n<br>\n<div align=\"center\"><font face=\"Arial, Helvetica, sans-serif\" size=1>This script can be found at <a href=\"http://www.proxy2.de\" target=\"_blank\"><font color=\"#000000\">http://www.proxy2.de</font></a>\n";
print "  </font></div>\n</form>\n</body>\n</html>\n";
exit (0);
}

sub delete_entry {

        my ($found);
        if ($FORM{'page'} !~ /$sub_page\d+\.html/) {
                open(FILE,"$base_dir/$book_file");
                $FORM{'page'} = $book_file;
        }
        else {
                open(FILE,"$base_dir/$FORM{'page'}");
        }
        @lines = <FILE>;
        close(FILE);
        $found=0;
        foreach $line (@lines) {
                if ($line =~ /^.*<!--top-ID=$FORM{'entry'} -->.*/) {
                        ($part1, $part2) = split(/<!--top-ID=$FORM{'entry'} -->\s*/,$line);
                        if ($part1) {
                                $line="$part1";
                        }
                        else {
                                $line="";
                        }
                        $found=1;
                        next;
                }
                elsif ($line =~ /^.*<!--end-ID=$FORM{'entry'} -->.*/) {
                        ($part3, $part4) = split(/<!--end-ID=$FORM{'entry'} -->\s*/,$line);
                        if ($part4) {
                                $line="$part4";
                        }
                        else {
                                $line="";
                        }
                        last;
                }
                elsif ($found==1) {
                        $line = "";
                }
        }
        if ($found==1) {
                open(FILE,">$base_dir/$FORM{'page'}");
                flock(FILE,2) if ($lock == 1);
                print FILE (@lines);
                close(FILE);
        }
}

# sendmail bugfix
# Thanks to Jason <[email protected]>
sub send_mail {
open (MAIL, "|$mailprog -t");
print MAIL "To: $recipient\n";
print MAIL "From: $FORM{'email'}\n";
print MAIL "Subject: New Guestbook Entry\n";
print MAIL "Reply-to: $FORM{'email'}\n";
print MAIL "There is a new entry in the guestbook:\n\n";
print MAIL "From:$FORM{'username'}\n";
print MAIL "$FORM{'message'}\n";
print MAIL "$this_day";
close (MAIL);
}

sub enterpass {
print "Content-type: text/html\n\n";
print <<ENTERHTML ;
<html>
<head>
<title>Guestbook - Administration</title>
<base href="$bookurl/">
</head>
<body bgcolor="#FFFFFF" link="#003399">
<table border="0" cellspacing="0" cellpadding="2" align="center" width="95%">
  <tr>
    <td height="45" width="55%"><b><font size="4" face="Verdana, Arial, Helvetica, sans-serif">Guestbook
      - Administration</font></b></td>
    <td height="45" width="45%">&nbsp;</td>
  </tr>
  <tr>
    <td width="55%" valign="bottom"><font size="1" face="Verdana, Arial, Helvetica, sans-serif">Guestbook
      - Administration Centre<br>
      Before you can proceed you have to enter a valid password!</font></td>
    <td width="45%" align="right" valign="bottom"> <b><font size="1" face="Verdana, Arial, Helvetica, sans-serif"><img src="point.gif" width="9" height="9"><a href="$book_file">Back
      to Guestbook</a> | <img src="point.gif" width="9" height="9"><a href="addentry.html">Sign
      the Guestbook</a></font></b></td>
  </tr>
</table>
<form method="post" action="$cgiurl">
  <table border="0" cellspacing="1" cellpadding="5" align="center" width="95%">
    <tr bgcolor="#BCBCDE">
      <td colspan="2"><font size="2" face="Verdana, Arial, Helvetica, sans-serif"><b>$_[0]</b></font></td>
    </tr>
    <tr bgcolor="#EFEFEF">
      <td width="30%" bgcolor="#EFEFEF"><font size="2" face="Verdana, Arial, Helvetica, sans-serif">Password:</font></td>
      <td width="70%">
        <input type="password" name="password" size="25">
        <input type="hidden" name="admin" value="enter">
      </td>
    </tr>
    <tr bgcolor="#EFEFEF">
      <td width="30%" bgcolor="#EFEFEF">&nbsp;</td>
      <td width="70%">
        <input type="submit" value="Submit">
      </td>
    </tr>
  </table>
</form>
<div align="center"><font face="Arial, Helvetica, sans-serif" color="#CCCCCC" size="1"><b>Guestbook
  Version 1.5<br>
  </b></font><b><a href="http://www.proxy2.de"><font face="Arial, Helvetica, sans-serif" color="#CCCCCC" size="1">http://www.proxy2.de</font></a></b></div>
</body>
</html>
ENTERHTML
exit (0);
}
sub error {
print "Content-type: text/html\n\n";
print <<ErrorHTML;
<html>
<head>
<title>Guestbook - Error</title>
<meta http-equiv="pragma" content="no-cache">
<style type="text/css">
<!--
td {  font-family: Verdana, Arial, Helvetica, sans-serif}
-->
</style>
<base href="$bookurl/">
<script language="JavaScript">
function goBack() {
        history.go(-1);
}
</script>
</head>
<body bgcolor="#FFFFFF" link="#003399">
<table border="0" cellspacing="0" cellpadding="2" align="center" width="95%">
  <tr>
    <td width="55%" height="40"><font size="4"><b>Guestbook - Error</b></font></td>
    <td width="45%" height="40">&nbsp;</td>
  </tr>
  <tr>
    <td width="55%"><font size="2">$_[0]</font></td>
    <td width="45%" align="right"> <b><font size="1"><img src="$arrow_img" width="9" height="9"><a href="javascript&#058;goBack()">Back
      to submit form</a> | <img src="$arrow_img" width="9" height="9"><a href="$book_file">Back to Guestbook</a></font></b></td>
  </tr>
</table><br>
ErrorHTML
if ($_[1] eq "fatal") {
print "<table width=\"95%\" border=0 cellspacing=1 cellpadding=5 align=center bgcolor=\"#FFFFFF\">\n";
print "<tr bgcolor=\"#BCBCDE\">\n    <td colspan=\"2\"><b><font size=\"2\">Environment Variables</font></b></td>\n  </tr>\n";
foreach $key (sort keys %ENV) {
  print "  <tr>\n    <td bgcolor=\"#D1E0E0\"><font size=\"2\">$key</font></td>\n    <td bgcolor=\"#EFEFEF\"><font size=\"2\">$ENV{$key}&nbsp;</font></td>\n  </tr>\n";
}
print "</table>\n";
}
print "<p align=\"center\"><font face=\"Arial\" size=\"1\" color=\"#CCCCCC\"><b>Guestbook Version 1.5<br>\n";
print "  </b></font><a href=\"http://www.proxy2.de\" target=\"_blank\"><b><font face=\"Arial\" size=\"1\" color=\"#CCCCCC\">http://www.proxy2.de</font></b></a></p>\n";
print "</body>\n</html>\n";
exit (0);
}

#!/usr/bin/perl -w
########################################################
#
# Código de ejemplo del tutorial: "Upload de archivos"
#
#
#
#
# http://perlenespanol.com/
#
#########################################################
use strict;
use CGI::Carp qw(fatalsToBrowser);
use CGI;
my %Input;
my $query = new CGI;
my @pairs = $query->param;
foreach my $pair(@pairs){
$Input{$pair} = $query->param($pair);
}

#Directorio donde queremos estacionar los archivos
my $dir = /public_html/upload";
#Array con extensiones de archivos que podemos recibir
my @extensiones = ('gif','jpg','jpeg','bmp','png');

recepcion_de_archivo(); #Iniciar la recepcion del archivo
#TODO SALIO BIEN
print "Content-type: text/html\n\n";
print "<h1>El archivo fue recibido correctamente</h1>\n";
exit(1);

sub recepcion_de_archivo{
my $nombre_en_servidor = $Input{'archivo'};
$nombre_en_servidor =~ s/ /_/gi;
$nombre_en_servidor =~ s!^.*(\\|\/)!!;

my $extension_correcta = 0;
foreach (@extensiones){
if($nombre_en_servidor =~ /\.$_$/i){
$extension_correcta = 1;
last;
}
}

if($extension_correcta){
#Abrimos el nuevo archivo
open (OUTFILE, ">$dir/$nombre_en_servidor") || die "No se puedo crear el archivo";
binmode(OUTFILE); #Para no tener problemas en Windows
#Transferimos byte por byte el archivo
while (my $bytesread = read($Input{'archivo'}, my $buffer, 10024)) {
print OUTFILE $buffer;
print OUTFILE $buffer;
print OUTFILE $buffer;

}
#Cerramos el archivo creado
close (OUTFILE);
}else{
print "Content-type: text/html\n\n";
print "<h1>Extension incorrecta</h1>";
print "Sólo se reciben archivo con extension:";
print join(",", @extensiones);
exit(0);
}

} #sub recepcion_de_archivo