AUXILIO ..! BRONCA CON UN CGI..

Crear páginas para Gecko, diferencias con IE, articulos de interés y recursos en español
systelecom
Recién llegado
Recién llegado
Mensajes: 1
Registrado: Mar Feb 10, 2009 11:53 pm

AUXILIO ..! BRONCA CON UN CGI..

Mensajepor systelecom » Mié Feb 11, 2009 12:08 am

Hola amigos, auxilio...
Soy un desarrollador básico...conseguí un Script para colocar en mi página, que permite al usuario poner su email y la de un destinatario, y el script se encarga de enviarle por mail un "link" para bajarse archivos grandes...algo similar a YouSendIt..
Funcioan genial...pero el problema es que los textos del CGI son muy básicos, el tipo de letra es "feo" (por decir lo menos) y yo que me he esmerado tanto en mi sitio WEB, el resultado del Script me lo daña todo...Desarrollé mi página en Joomla, tiene una presentación chévere pero el Script sale muy feo dentro de un "Iframe".
LO QUE NECESITO, es que por favor me digan cómo hago para poder cambiarle los fonts, los colores, tipografía, etc. al resultado que me arroja el script.
Tengo en éste momento, corriendo un ejemplo de ese script aquí:
http://www.proteus.ec/index.php?option= ... &Itemid=58

El sitio original donde conseguí el Script es:
http://fex.rus.uni-stuttgart.de/


El código fuente del script lo pongo al final, porque es un poco largo. GRACIAS MIL..!
====================

Código: Seleccionar todo

#!/usr/bin/perl -wT

# F*EX CGI for upload
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#
# Contribs:
#   Sebastian Zaiser <szcode@arcor.de> (upload status)
#
# Copyright: GNU General Public License


use Encode;
use Fcntl    qw(:flock :seek :mode);
use IO::Handle;
use Digest::MD5   qw(md5_hex);

# add fex lib
$FEXLIB =
  $0 =~ m:(/.+)/.+/: ? "$1/lib":
  $0 =~ m:(.*/):     ? "$1/../lib":
                       "../lib";
die "$0: no $FEXLIB\n" unless -d $FEXLIB;

$| = 1;

our $debug;
our $ndata = 0;
our $error = 'F*EX upload ERROR';
our $head = "$ENV{SERVER_NAME} F*EX upload";
our $autodelete = 'YES';

# import from fex.pp
our ($spooldir,$durl,$tmpdir,$logdir,$keep_default,$hostname,$admin,$fra);
our ($fop_auth);

my $data;
my $boundary;
my $rb = 0;      # read bytes, totally
my $seek = 0;
my $rid = '';      # real ID
my @header;      # HTTP entity header

# load common code, local config: $FEXLIB/fex.ph
require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";

# load fup local config
our ($info_1,$info_2);
require "$FEXLIB/fup.pl" or die "$0: cannot load $FEXLIB/fup.pl - $!\n";

chdir $spooldir or http_die("$spooldir - $!\n");

my $log     = "$logdir/fup.log";

my $dkeydir = "$spooldir/.dkeys"; mkdirp($dkeydir); # download keys
my $ukeydir = "$spooldir/.ukeys"; mkdirp($ukeydir); # upload keys
my $akeydir = "$spooldir/.akeys"; mkdirp($akeydir); # authentification keys

my $http_client = $ENV{HTTP_USER_AGENT} || '';
my $ra = untaint($ENV{REMOTE_ADDR});
$fra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};

$from = $to = $id = $file = $comment = $akey = '';
# $sid = '';
$data = '';

&parse_request; # showstatus will not come back
$uid = randstring(8) unless $uid; # upload ID

# user requests for for forgotten ID
if ($from and $id_forgotten) {
  $id = '';
  if (open $from,"./$from/\@") {
    $id = <$from> || '';
    chomp $id;
    close $from;
  }
  if ($id) {
    open P,"|/usr/lib/sendmail -t" or http_die("cannot start sendmail - $!\n");
    print P <<EOD;
From: $admin
To: $from
Subject: F*EX service $hostname
Bcc: fex

Your reqested F*EX auth-ID for $hostname is:
$id
EOD
    close P or http_die("cannot send mail - $!\n");
    http_header('200 OK');
    print html_header($head);
    print "<h3>Mail has been sent to you ($from)</h3>\n";
    print "</body></html>\n";
  } else {
    http_die("unknown F*EX user $from");
  }
  exit;
}

# look for regular sender ID
if ($id and $from) {
  if (open $from,"./$from/\@") {
    $rid = <$from> || '';
    chomp $rid;
    close $from;
    $rid = sidhash($rid,$id);
  } else {
    my $error = $!;
    # if recipient (to) is specified, we have to look for subusers later, too
    unless ($to) {
      fuplog("ERROR: $spooldir/$from/\@ $error");
      debuglog("cannot open $spooldir/$from/\@ : $error");
      http_die("Wrong auth-ID");
    }
  }
}

# look for (registered) recipients special receiver ID (= subuser)
if ($from and $id and $to and $to !~ /,/ and $id ne $rid and open $to,"./$to/@") {
  # skip recipients own ID
  $_ = <$to>;
  # sub user list MUST be sorted upside down,
  # anotherwise wildcard * will match first - bad idea!
  foreach (reverse sort <$to>) {
    chomp;
    # special receiver ID (subuser)?
    if (s/(.+?)://) {
      my $sr = lc($1);
      if (lc($from) eq $sr
          or $sr eq '*' or $sr eq '*@*'
          or $sr =~ /^\*\@(.+)/ and $from =~ /\@\Q$1\E$/i
          or $sr =~ /(.+)\@\*$/ and $from =~ /^\Q$1\E\@/i) {
        $rid = sidhash($_,$id);
        $subuser = $sr;
        last;
      }
    }
  }
  close $to;
}

# check ID
if ($from and $id) {
  if ($rid and $rid eq $id) {
    if (-d $akeydir and not $akey and $id !~ /^MD5H:/) {
      $akey = untaint(md5_hex("$from:$id"));
      symlink "../$from","$akeydir/$ra:$akey";
    }
  } else {
    fuplog("ERROR: wrong auth-ID $id");
    debuglog("id sent by user $from=$id, real id=$rid");
    http_die("Wrong auth-ID");
  }
}

if ($from and $to and $id and $rid eq $id) {
 
  if ($comment eq 'LIST') {
    http_header('200 OK');
    print html_header($head);
    print "<h3>Files on $hostname for $to:</h3>\n",
          "<pre>\n";
    foreach $from (glob "$to/*") {
      next if $from =~ /[A-Z]/;
      $from =~ s:.*/::;
      $url = '';
      foreach $file (glob "$to/$from/*") {
        next if $file =~ /\/STDFEX$/;
        $size = -s "$file/data";
        next unless $size;
        $size = int($size/1024/1024+0.5);
        if ($dkey = readlink "$file/dkey") {
          print "\n<p>from $from :<p>\n" unless $url;
          $file =~ s:.*/::;
          $url = "$durl/$dkey/$file";
          unless (-l "$dkeydir/$dkey") {
            symlink untaint("../$to/$from/$file"),untaint("$dkeydir/$dkey");
          }
          # printf "%8s MB <a href=\"%s\">%s : %s</a>\n",$size,$url,$from,$file;
          printf "[<a href=\"/fup?akey=%s&to=%s&file=%s&comment=DELETE\">delete</a>]",
                 $akey,$to,$file;
#         printf "[<a href=\"%s?DELETE\">delete</a>]",$url;
          printf "%8s MB <a href=\"%s\">%s</a>\n",$size,$url,$file;
        }
      }
    }
    print "</pre>\n";
    print "</body></html>\n";
    exit;
  }

  if ($file and $comment eq 'DELETE') {

    foreach $to (@to) {
      $del = "$to/$from/$file";
      $del =~ s:^/+::;
      if ($del =~ /\/\./) {
        http_die("illegal parameter $del");
      }
      $del = untaint($del);
     
      if (unlink("$del/data") or unlink("$del/upload")) {
        if (open F,">$del/error") {
          print F "$file has been deleted by $from\n";
          close F;
        }
        http_header('200 OK');
        print html_header($head);
        print "<h3>$file deleted</h3>\n";
      } else {
        http_header('404 Not Found');
        print html_header($head);
        print "<h3>$file not deleted</h3>\n";
      }
      printf "<a href=\"/fup?akey=%s&to=%s&comment=LIST\">continue</a>\n",
             $akey,$to;
      print "</body></html>\n";
    }
    exit;
  }
}

# check recipients restriction
if ($id and $id eq $rid and $from and $to
    and -s "$from/\@ALLOWED_RECIPIENTS"
    and open F,"$from/\@ALLOWED_RECIPIENTS") {
  my ($allowed,$ar);
  while (<F>) {
    chomp;
    s/#.*//;
    s/\s//g;
   
    # allow wildcard *, but not regexps
    $ar = quotemeta $_;
    $ar =~ s/\\\*/[^@]*/g;
   
    if ($to =~ /^$ar$/i or "$to\@$mdomain" =~ /^$ar$/i) {
      $allowed = 1;
      last;
    }
  }
  close F;

  unless ($allowed) {
    fuplog("ERROR: $from not allowed to fex to $to");
    debuglog("$to not in $spooldir/$from/\@ALLOWED_RECIPIENTS");
    http_die("You ($from) are not allowed to fex to $to");
  }
}     

# on secure mode "fop authorization" also check if recipient(s) exists
# (= has a F*EX ID)
if ($fop_auth and $id and $id eq $rid and $from and $to) {
  my ($to_reg,$idf,$subuser);
  foreach my $to (split(',',$to)) {
    $to_reg = 0;
    # full user?
    if (open $idf,"$to/@") {
      $to_reg = <$idf> || '';
      chomp $to_reg;
      close $idf;
    }
    # sub user?
    elsif (open $idf,"$from/@") {
      while (<$idf>) {
        next unless /:/;
        chomp;
        ($subuser) = split ':';
        if ($subuser eq $to or $subuser eq '*@*'
            or $subuser =~ /^\*\@(.+)/ and $to =~ /\@\Q$1\E$/i
            or $subuser =~ /(.+)\@\*$/ and $to =~ /^\Q$1\E\@/i) {
          $to_reg = $_;
          last;
        }
      }
      close $idf;
    }
    unless ($to_reg) {
      http_die("recipient $to is not a registered F*EX full or sub user");
    }
  }
}
# display HTML form and request user data


unless ($file) {
  if ($test) {
    $cgi = $test;
  } else {
    $cgi = $ENV{SCRIPT_NAME};
  }
  http_header('200 OK','Content-Type: text/html; charset=UTF-8');
  # print html_header($head,'<img src="/fex_small.gif">');
  print html_header($head);
  if ($http_client =~ /(Konqueror|w3m)/) {
    print <<EOD
<p><hr><p>
<center><h3>
Your client seems to be \"$1\" which is incompatible with F*EX and will probably not work!
</h3>
We recommend firefox.
</center>
<p><hr><p>
EOD
  }
  if ($from and $id) {
    $submit = "submit";
    print <<EOD;
<script type="text/javascript">
  function showstatus() {
    var file = document.forms["upload"].elements["file"].value;
    if (file != "") {
      window.open('$ENV{PROTO}://$ENV{HTTP_HOST}/$cgi?showstatus=$uid','fup_status','width=700,height=220');
      return true;
    } else {
      return false;
    }
  }
</script>
<form name="upload"
      action="$cgi"
      method="post"
      accept-charset="UTF-8"
      enctype="multipart/form-data"
      onsubmit="return showstatus();">
  <table>
    <input type="hidden" name="uid"  value="$uid">
    <input type="hidden" name="from" value="$from">
    <input type="hidden" name="id"   value="$id">
    <tr><td>sender:   <td>$from</tr>
EOD
  if ($subuser) {
    print <<EOD;
    <input type="hidden" name="to"   value="$to">
    <tr><td>recipient:<td>$to</tr>
EOD
  } else {
    print <<EOD;
    <tr><td>recipient(s):
        <td><input type="text" name="to"      size="60" value="$to"></tr>
EOD
  }
    print <<EOD;
    <tr><td>comment:
        <td><input type="text" name="comment" size="80" value="$comment">(optional)</tr>
    <tr><td>file name:
        <td><input type="file" name="file"    size="80" value="$file"></tr>
  </table>
  <p><input type="submit" value="$submit"><p>
EOD
#    print <<EOD if $from eq $to;
#    <tr><td>keep file:
#        <td><input type="text" name="keep" size="1" value="$keep"> days
#    (and do not auto-delete it after download)
#    </tr>
#  </table>
# EOD
  } else {
    $submit = "check ID and continue";
    print <<EOD;
<h5>
<form action="$cgi"
      method="post"
      accept-charset="ISO-8859-1"
      enctype="multipart/form-data">
  <table>
    <tr><td>sender:
        <td><input type="text"     name="from" size="40" value="$from"></tr>
    <tr><td>recipient(s):
        <td><input type="text"     name="to"   size="40" value="$to"></tr>
    <tr><td>auth-ID:       
        <td><input type="password" name="id"   size="16" value="$id"></tr>
  </table>
  <input type="checkbox" name="ID_forgotten" value="ID_forgotten">
  I have lost my auth-ID! Send it to me by e-mail!
  (you must fill out sender field above)
  <p><input type="submit" value="$submit"><p>
EOD
    if (@local_hosts and ipin($ENV{REMOTE_ADDR}||0,@local_hosts)) {
      print <<EOD;
   You can <a href="/fur">register yourself</a>
   if you do not have a F*EX account yet.<p>
EOD
    }
  }
  print <<EOD;
</form>
</h5>
EOD
   
 if ($akey and -f "$from/@") {
   print <<EOD;
<p>
<a href="foc?akey=$akey">user config / operation control</a>
EOD
 }
 
  if ($from and $id) {
    print $info_2;
  } else {
    print $info_1;
  }

  if ($debug and $debug>1) {
    print "<hr>\n<pre>\n";
    foreach $v (sort keys %ENV) {
      print "$v = $ENV{$v}\n";
    }
    print "</pre>\n";
  }
 
  print "</body></html>\n";
  exit;
}

# all these variables should be defined here, but just to be sure...
http_die("no file specified")      unless $file;
http_die("no sender specified")      unless $from;
http_die("no recipient specified")   unless @to;
http_die("wrong auth-ID specified")   unless $rid eq $id;

$dkey = get_file();

foreach $to (@to) {
  $filed = "$to/$from/$file";
  $save = $filed . '/data';
  if (unlink $save) {
    $overwrite{$to}++;
  }
  rename "$filed/upload",$save
    or http_die("cannot rename $filed/upload to $save - $!\n");
}

http_header('200 OK',"Location: $durl/$dkey/$file");
print html_header($head);

if ($ndata) {
  fuplog($to,encode_Q($file),$ndata);
  if ($ndata<2*1024) {
    print "$file ($ndata B) received and saved<p>\n";
    print "Ehh... $ndata <b>BYTES</b>?! You are kidding?<p>\n" unless $seek;
  } elsif ($ndata<2*1024*1024) {
    $ndata = int($ndata/1024);
    print "$file ($ndata kB) received and saved<p>\n";
    if ($ndata<1024 and not $seek) {
      print "Using F*EX for less than 1 MB: ",
            "ever heard of MIME e-mail? :-)<p>\n";
    }
  } else {
    $ndata = int($ndata/1024/1024);
    print "$file ($ndata MB) received and saved<p>\n";
  }
  if ($comment ne 'NOMAIL') {
    foreach $to (@to) {
      if ($overwrite{$to}) {
        print "(old $file overwritten)<p>\n";
      } else {
        debuglog("notify $to/$from/$file [$filename] '$comment'");
        &notify("new","$to/$from/$file",
                $filename,$keep||$keep_default,0,$comment,$autodelete);
        print "$to notified<p>\n";
      }
    }
  }
  $to = join(',',@to);
  print "<a href=\"/fup?akey=$akey&to=$to\">send another file</a>\n";
} else {
  http_die("No file data received! File name correct?");
}

print "</body></html>\n";
exit;


sub checkchars {
  my $input = shift;
  local $_ = shift;
  http_die("\"$1\" is not allowed at beginning of $input $_") if /^([<>|+])/;
  http_die("\"$1\" is not allowed in $input $_")              if /([\/,])/;
  http_die("\"$1\" is not allowed at end of $input $_")       if /([<>|])$/;
}

# parse GET and POST requests
sub parse_request {
  my $qs = $ENV{QUERY_STRING};
  my ($name,$value);
  my $cl;
  my $dkey;
  local $_;

  # parse HTTP QUERY_STRING
  foreach (split '&',$qs) {
    /(.+?)=(.*)/;
    $name  = $1 || $_;
    $value = $2 || '';
    # decode %URL-encoded parameters
    $value =~ s/%([a-f0-9]{2})/chr(hex($1))/gie;
    # die "$qs\n$value\n".normalize_filename($value) if $name =~ /file/i;   
    setparam($name,$value);
  };
 
  &showstatus if $showstatus;

  if ($ENV{REQUEST_METHOD} eq 'POST' and $cl = $ENV{CONTENT_LENGTH}) {
    foreach $sig (keys %SIG) {
      if ($sig !~ /^(CHLD|CLD)$/) {
        $SIG{$sig} = \&sigexit;
      }
    }
    $SIG{__DIE__} = \&sigdie;
    http_die("invalid Content-Length header \"$cl\"") unless $cl =~ /^\d+$/;
    debuglog("awaiting $cl bytes");
    $SIG{ALRM} = sub { die "TIMEOUT" };
    alarm($timeout);
    if ($ENV{CONTENT_TYPE} =~ /boundary=\"?([\w\-\+\/_]+)/) {
      $boundary = $1;
    } else {
      http_die("malformed HTTP POST (no boundary found)");
    }
   
    binmode(STDIN,':raw');
   
    READPOST: while (&nvt_read) {
      # the file itself - *must* be last part of POST!
      if (/^Content-Disposition:\s*form-data;\s*name="file";\s*filename="(.+)"/i) {
        push @header,$_;
        $file = $param{'FILE'} = $1;
        $file =~ s/%(\d+)/chr($1)/ge;
        $file =~ s/[\r\n]+/ /g;
        $filename = strip_path($file);
        $file = decode_utf8($file,Encode::FB_DEFAULT);
        $file = normalize_filename($file);
        while (&nvt_read) {
          last if /^\s*$/;
          push @header,$_;
        }
        # STDIN is now at begin of file, will be read later with get_file()
        last;
      }
      # all other parameters
      if (/^Content-Disposition:\s*form-data;\s*name="([a-z][_\w]*)"/i) {
        $name = $1;
        nvt_skip_to('^\s*$');
        &nvt_read;
#       setparam($name,decode_utf8($_,Encode::FB_DEFAULT));
        setparam($name,$_);
        NEXTPART: while (&nvt_read) {
          last READPOST if /^--\Q$boundary--/;
          last NEXTPART if /^--\Q$boundary/;
        }
      }
    }
   
    if ($from) {
      # check for short alias
      $from = $1 if $from =~ /(.+)\@\Q$mdomain\E$/i and -f "$1/@";
      unless (-d $from) {
        checkchars('from address',$from);
        unless (checkaddress($from)) {
          http_die("$from is not a valid e-mail address");
        }
      }
    }
   
    # collect multiple addresses
    if ($to) {
      my %to;
      foreach $to (split(',',$to)) {
        # check for short alias
        # $to = $1 if $to =~ /(.+)\@\Q$mdomain\E$/i and -f "$1/@";
        unless (-d $to) {
          checkchars('to address',$to);
          http_die("\"$to\" is not a valid e-mail address") unless checkaddress($to);
        }
        # ignore dupes
        $to{$to} = $to;
      }
      @to = keys %to;
    }
  }
}


# show the status progress bar
sub showstatus {
  my $wclose;
  my ($upload,$sfile,$ukey);
  my ($nsize,$tsize);
  my ($t0,$t1,$t2,$tt,$ts,$tm);
  my $osize = 0;
  my $percent = 0;
  my $npercent = 0;
  local $_;

  $wclose = '<p><a href="#" onclick="window.close()">close</a>'."\n".
            '</body></html>'."\n";
  $to =~ s/,.*//;
  $ukey = "$ukeydir/$uid";
  $upload = "$ukey/upload";
  $sfile = "$ukey/size";
  for (1..10) {
    sleep 1;
    if (-s $sfile and open $sfile,$sfile) {
      $tsize = <$sfile>;
      chomp $tsize;
      close $sfile;
      last;
    }
    # upload error?
    # remark: stupid Internet Explorer *needs* the error represented in this
    # asynchronous popup window, because it cannot display the error in the
    # main window on HTTP POST!
    if (-f $ukey and open $ukey,$ukey or
        -f "$ukey/error" and open $ukey,"$ukey/error") {
      undef $/;
      html_error($error,<$ukey> || 'unknown');
      unlink $ukey;
      exit;
    }
  }
  # unlink $sfile;
 
  if (defined $tsize and $tsize == 0) {
    print "<script type='text/javascript'>window.close()</script>\n";
    exit;
  }
  http_die("no file data received - does your file exist?") unless $tsize;
  http_die("file size unknown") unless $tsize =~ /^\d+$/;
 
  http_header('200 OK','Content-Type: text/html; charset=UTF-8');
  if (open $ukey,"$ukey/filename") {
    local $/;
    $file = <$ukey>;
    close $ukey;
  }
  http_die("no filename?!") unless $file;
 
  print <<EOD;
<html><body><h1>Upload Status for <tt>$file</tt></h1>
<input type='text' id='percent' style='margin-left:1ex;color:black;background:transparent;border:none;width:32ex;' disabled='true' value='0%'>
<div style='border:1px solid black;width:100%;height:20px;'>
<div style='float:left;width:0%;background:black;height:20px;' id='bar'>
</div></div>
EOD
   
  # check for upload file
  for (1..5) {
    last if -f $upload or -f "$ukey/data";
    sleep 1;
  }
  unless (-f $upload or -f "$ukey/data") {
    print "<p><H3>ERROR: no upload received</H3>\n";
    print $wclose;
    exit;
  }
 
  $SIG{ALRM} = sub { die "TIMEOUT in showstatus\n" . $wclose };
  alarm($timeout*2);
  $t0 = $t1 = time;
 
  for ($percent = 0; $percent<100; sleep(1)) {
    $t2 = time;
    $nsize = -s $upload;
    if (defined $nsize) {
      if ($nsize<$osize) {
        print "<p><H3>ABORTED</H3>\n";
        print $wclose;
        exit;
      }
      if ($nsize>$osize) {
        alarm($timeout*2);
        $osize = $nsize;
      }
      $npercent = int($nsize*100/$tsize);
      $showsize = calcsize($tsize,$nsize);
    } else {
      $npercent = 100;
      $showsize = calcsize($tsize,$tsize);
    }
    # hint: for ISDN (or even slower) links, 5 s tcp delay is minimum
    # so, updating more often is contra-productive
    if ($t2>$t1+5 or $npercent>$percent) {
      $percent = $npercent;
      $t1 = $t2;
      $tm = int(($t2-$t0)/60);
      $ts = $t2-$t0-$tm*60;
      $tt = sprintf("%d:%02d",$tm,$ts);
      print <<EOD or last;
<script type='text/javascript'>
  document.getElementById('bar').style.width = '$percent%';
  document.getElementById('percent').value = '$showsize, $tt, $percent %';
</script>
EOD
    }
  }
 
  alarm(0);
  print "<h3>file successfully transfered</h3>\n";
  print $wclose;
  unlink $ukey;
  exit;
}


# get file from post request
sub get_file {
  my ($to,$filed,$upload,$nupload,$speed,$data);
  my ($b,$n,$uss);
  my $dkey;
  my ($fh,$filesize);
  my ($t0,$tt);
  my $fb = 0;         # file bytes
  my $cl = $ENV{CONTENT_LENGTH};

  foreach $to (@to) {
    $filed = "$to/$from/$file";
    $nupload = "$filed/upload";
    mkdirp($filed);
    unlink "$filed/autodelete",
           "$filed/error",
           "$filed/download",
           "$filed/keep",
           "$filed/header",
           "$filed/speed",
           "$filed/notify";
    # do not delete $filed/data, because we need it later to determine if we
    # are in overwrite mode!
   
    if ($upload) {
      if ($upload eq $nupload or
          -r $upload and -r $nupload and
          (stat $upload)[1] == (stat $nupload)[1]) {
        next;
      }
      unlink $nupload;
      link $upload,$nupload;
      link $speed,"$filed/speed";
    } else {
      $upload = $nupload;
      unlink "$ukeydir/$uid";
      open $upload,">>$upload" or http_die("cannot create $upload - $!");
      unless (flock($upload,LOCK_EX|LOCK_NB)) {
        http_die("$file locked: a transfer is already in progress");
      }
      $data = "$filed/data";
      if (-f $data and open $data,">>$data") {
        unless (flock($data,LOCK_EX|LOCK_NB)) {
          http_die("$filed locked: a download is currently in progress");
        }
      }
      unless ($seek) {
        seek $upload,0,0;
        truncate $upload,0;
      }
      $uss = -s $upload;
      # provide upload ID symlink for showstatus
      symlink "../$filed","$ukeydir/$uid";
      $speed = "$filed/speed";
      open $speed,">$speed";
    }
   
    # showstatus needs file name and size
    open $fh,">$filed/filename" or die "cannot write $filed/filename - $!\n";
    print {$fh} $filename;
    close $fh;
    $filesize = $cl-$rb-(length($boundary)+8); # 8: 2 * CRLF + 2 * "--"
    open $fh,">$filed/size" or die "cannot write $filed/size - $!\n";
    print {$fh} $filesize,"\n";
    close $fh;
   
    if ($autodelete eq 'DELAY' or $autodelete eq 'NO') {
      if (open $autodelete,">$filed/autodelete") {
        print {$autodelete} $autodelete,"\n";
        close $autodelete;
      }
    }
   
    if ($keep and open $fh,">$filed/keep") {
      print {$fh} $keep,"\n";
      close $fh;
    }
   
    if (@header and open $fh,">$filed/header") {
      print {$fh} join("\n",@header),"\n";
      close $fh;
    }
   
    if ($comment eq 'NOMAIL') {
      open $fh,">$filed/notify";
      close $fh;
    }
   
    # provide download ID key
    unless ($dkey = readlink("$filed/dkey") and -l "$dkeydir/$dkey") {
      $dkey = randstring(8);
      unlink "$dkeydir/$dkey";
      symlink "../$filed","$dkeydir/$dkey" or die "cannot symlink $dkeydir/$dkey";
      unlink "$filed/dkey";
      symlink $dkey,"$filed/dkey";
    }
   
  }

  # at last, read file data
  alarm($timeout);
  debuglog("still awaiting $cl-$rb =",$cl-$rb,"bytes");
  $t0 = time();
  while ($rb<$cl) {
    $b = $cl-$rb;
    $b = $bs if $b>$bs;
    # max wait for 1 kB/s, but at least 10 s
    $timeout = $b/1024;
    $timeout = 10 if $timeout < 10;
    alarm($timeout);
    if ($n = read(STDIN,$_,$b)) {
      $rb += $n;
      $fb += $n;
      print {$upload} $_;
      # debuglog($_);
    } else {
      last;
    }
  }
  alarm(0);       
  close $upload; # or die "cannot close $upload - $!\n";;

  # throuput in kB/s
  $tt = (time()-$t0) || 1;
  printf {$speed} "%d\n",$fb/1024/$tt;
  close $speed;
 
  # size of transfered (partial) file
  $ndata = untaint($fb-length($boundary)-8);

  # truncate boundary string
  truncate $upload,$ndata+$uss if -s $upload > $ndata+$uss;
  if ($cl != $rb) {
    $to = join(',',@to);
    fuplog($to,encode_Q($file),$ndata,'(aborted)');
    http_die("read $rb bytes, but CONTENT_LENGTH announces $cl bytes");
  }
 
  # save error?
  if ($filesize > -s $upload) {
    $to = join(',',@to);
    fuplog($to,encode_Q($file),$ndata,'(write error)');
    http_die("internal server error while writing file data");
  }
 
  debuglog("upload successfull, dkey=$dkey");
  return $dkey;
}


sub calcsize {
  my ($tsize,$nsize) = @_;
  if ($tsize<2097152) {
    return sprintf "%d kB",int($nsize/1024);
  } else {
    return sprintf "%d MB",int($nsize/1048576);
  }
}

# read one line from STDIN (net socket) and assign it to $_
# returns number of read bytes
sub nvt_read {
  my $len = 0;

  if (defined ($_ = <STDIN>)) {
    debuglog($_);
    $len = length;
    $rb += $len;
    s/\r?\n//;
  }
  return $len;
}

# read forward to given pattern
sub nvt_skip_to {
  my $pattern = shift;

  while (&nvt_read) { return if /$pattern/ }
}

sub normalize {
  local $_ = shift;
 
  $_ = decode_utf8($_,Encode::FB_DEFAULT);
  s/[\x00-\x1F]/ /g;
  s/[\x80-\x9F]/_/g;
  s/^\s+//;
  s/\s+$//;
  return encode_utf8($_);
}

# remove all white space
sub despace {
  local $_ = shift;
  s/\s//g;
  return $_;
}

# set parameter variables
sub setparam {
  my ($v,$vv) = @_;
  my $key;
 
  $v = uc(despace($v));
  $vv = untaint(normalize($vv));
  $param{$v} = $vv;
  if ($v eq 'KEY') {
    $key   = normalize_filename($vv);
    if (open $key,".skeys/$key") {
      while (<$key>) {
        if (/^(\w+)=(.+)/) {
          $from = $2 if lc($1) eq 'from';
          $to   = $2 if lc($1) eq 'to';
          $id   = $2 if lc($1) eq 'id';
        }
      }
      close $key;
    }
  } elsif ($v eq 'AKEY') {
    $akey = despace($vv);
    if (open $idf,"$akeydir/$ra:$akey/@" and $id = <$idf>) {
      chomp $id;
      close $idf;
      $from = readlink "$akeydir/$ra:$akey";
      $from =~ s:.*/::;
      if ($akey ne md5_hex("$from:$id")) {
        $from = $id = '';
      }
    }
  } elsif ($v eq 'FROM' or $v eq 'USER') {
    $from   = lc(despace($vv));
  } elsif ($v eq 'TO') {
    $to      = lc($vv);
    $to      =~ s/^\s+//;
    $to      =~ s/\s+$//;
    $to      =~ s/[\n\s]+/,/g;
    $to      =~ s/,,+/,/g;
    @to      = split(',',$to);
  } elsif ($v eq 'ID') {
    $id      = despace($vv);
# } elsif ($v eq 'SID') {
#   $sid   = despace($vv);
  } elsif ($v eq 'TCE') {
    $test   = despace($vv);
  } elsif ($v eq 'FILE') {
    $file   = normalize_filename($vv);
  } elsif ($v eq 'UID') {
    $uid = $vv;
  } elsif ($v eq 'ID_FORGOTTEN') {
    $id_forgotten = $vv;
  } elsif ($v eq 'SHOWSTATUS') {
    $showstatus = $uid = $vv;
  } elsif ($v eq 'COMMENT') {
    $comment   = $vv;
  } elsif ($v eq 'AUTODELETE') {
    $autodelete   = uc(despace($vv));
  } elsif ($v eq 'KEEP' and $vv =~ /^\s*(\d+)\s*$/) {
    $keep   = $1;
  } elsif ($v eq 'SEEK' and $vv =~ /^\s*(\d+)\s*$/) {
    $seek   = $1;
  }
}

# UTF8 to latin1
sub utf8decode {
  local $_ = shift;
  s/([\xC0-\xDF])([\x80-\xBF])/chr(ord($1)<<6&0xC0|ord($2)&0x3F)/eg;
  return $_;
}

# global substitution as a function like in gawk
sub gsub {
  local $_ = shift;
  my ($p,$r) = @_;
  s/$p/$r/g;
  return $_;
}

# standard log
sub fuplog {
  my $msg = "@_";
 
  $msg =~ s/\n/ /g;
  $msg =~ s/\s+$//;
 
  if (open $log,">>$log") {
    flock $log,LOCK_EX;
    seek $log,0,SEEK_END;
    printf {$log} "%s %s (%s) %s\n",isodate(time),$from,$fra,$msg;
    close $log;
  }
}

sub sigdie {
  local $_ = shift;
  chomp;
  sigexit('DIE',$_);
}

sub sigexit {
  my ($sig) = @_;
  my $msg;
 
  $msg = @_ ? "@_" : '???';
  $msg =~ s/\n/ /g;
  $msg =~ s/\s+$//;
 
  if (open $log,">>$log") {
    printf {$log}
           "%s %s (%s) %s %s caught SIGNAL $msg %s\n",
           isodate(time),$from||'-',$fra||'-',$to||'-',encode_Q($file||'-'),
           $rb?"(after $rb bytes)":"";
    close $log;
  }
  $SIG{__DIE__} = '';
  if ($sig eq 'DIE') {
    shift;
    die "$msg\n";
  } else {
    die "SIGNAL $msg\n";
  }
}

Pelon

Re: AUXILIO ..! BRONCA CON UN CGI..

Mensajepor Pelon » Jue Feb 19, 2009 2:53 pm

No revise el codigo que adjuntas porque creo que tu problema pasa por el CSS. Mira el codigo final que genera el script que conseguiste y a ese dale un estilo ( CSS ) que vaya con la linea visual de tu sitio. Avisanos como te va para poder ayudarte.


Volver a “Desarrollo web (HTML/CSS/JS, accesibilidad...)”

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 1 invitado