[# IMPORTANTE: ES NECESARIO QUE ESTE SCRIPT SE PONGA EN LA BARRA DE LA INTRANET NO EN SISTEMAS/INTRANET PORQUE LA COOKIE FUNCIONA A PARTIR DEL DIRECTORIO EN EL CUAL ESTE ESTE SCRIPT. #] [- use CGI qw/:standard/; use CGI::Cookie; if (!defined($fdat{'redirect'})) { $http_headers_out {Location} = '/sistemas/intranet'; exit; } %cookies = fetch CGI::Cookie; $archivo = '/tmp/sess_'.$cookies{'PHPSESSID747F'}{'value'}[0]; open (FILE, $archivo); $linea = join ('',); $res = parseSession (linea => $linea); $udat{'user'} = $res->{'user'}; $udat{'domain'} = $res->{'domain'}; $udat{'nick'} = $res->{'nick'}; $udat{'nro_doc'} = $res->{'nro_doc'}; $http_headers_out {Location} = '/'.$fdat{'redirect'}; exit; ################# FIN SCRIPT sub parseSession { my %params = @_; my $op_value = $params{linea}; my $pos = 0; my $name; my $type; my $type2; my $len; my $result; while ($pos < 2){ #Obtengo el nombre del parametro $name = substr($op_value, 0, index($op_value, '|')); $op_value = substr($op_value, index($op_value, '|') + 1); #Depuro la linea #Obtengo el tipo $type = substr($op_value, 0, index($op_value, ':')); $type2 = substr($op_value, 0, index($op_value, ';')); #Caso particular if ($type2 eq 'N') { $type = 'N'; $op_value = substr($op_value, index($op_value, ';') + 1); #Depuro la linea } else { $op_value = substr($op_value, index($op_value, ':') + 1); #Depuro la linea } if ($type eq 's') { #Obtengo la longitud $len = substr($op_value, 0, index($op_value, ':')); #Obtengo el resto de la linea $op_value = substr($op_value, index($op_value, ':') + 1); if ($name eq 'usuario') { $result->{'user'} = substr($op_value, 1, $len); ($result->{'nick'}, $result->{'domain'}) = split ('@', $result->{'user'}); $op_value = substr($op_value, $len + 3); $pos++; } elsif ($name eq 'documento') { $result->{'nro_doc'} = substr($op_value, 1, $len); $pos++; } else { $op_value = substr($op_value, $len + 3); } } elsif ($type eq 'i') { $op_value = substr($op_value, index($op_value,';') + 1); } elsif ($type eq 'd') { $op_value = substr($op_value, index($op_value,';') + 1); } elsif ($type eq 'b') { $op_value = substr($op_value, index($op_value,';') + 1); } elsif ($type eq 'a') { $op_value = parseContenido (cont => $op_value); } elsif ($type eq 'O') { $len = substr($op_value, 0, index($op_value,':')); $op_value = substr($op_value, index($op_value,':') + 1); $op_value = substr($op_value, $len + 3); $op_value = parseContenido (cont => $op_value); } if (length($op_value) < 1) { $pos = 3; } } return $result; } #Devuelve la linea sin el contenido sub parseContenido { my %params = @_; my $op_value = $params{cont}; my $type; my $type2; my $len; my $seguir = 1; #Elimino todo hasta el { inclusive $op_value = substr($op_value, index($op_value, ':') + 2); while ($seguir) { #Obtengo el tipo $type = substr($op_value, 0, index($op_value, ':')); $type2 = substr($op_value, 0, index($op_value, ';')); #Caso particular Null #Caso particular Null if ($type2 eq 'N') { $type = 'N'; $op_value = substr($op_value, index($op_value, ';') + 1); #Depuro la linea } else { $op_value = substr($op_value, index($op_value, ':') + 1); #Depuro la linea } if ($type eq 's') { #Obtengo la longitud $len = substr($op_value, 0, index($op_value, ':')); #Obtengo el resto de la linea $op_value = substr($op_value, index($op_value, ':') + 1); $op_value = substr($op_value, $len + 3); } elsif ($type eq 'i') { $op_value = substr($op_value, index($op_value,';') + 1); } elsif($type eq 'd') { $op_value = substr($op_value, index($op_value,';') + 1); } elsif($type eq 'b') { $op_value = substr($op_value, index($op_value,';') + 1); } elsif($type eq 'a') { $op_value = parseContenido (cont => $op_value); } elsif($type eq 'O') { $op_value = parseContenido (cont => $op_value); } if (substr($op_value,0,1) eq '}') { $op_value = substr($op_value,1); $seguir = 0; } } return $op_value; } -] 1;