embperl/Php2Embperl_Session.epl

   1 [#
   2 IMPORTANTE: ES NECESARIO QUE ESTE SCRIPT SE PONGA EN LA BARRA DE LA INTRANET NO
   3 EN SISTEMAS/INTRANET PORQUE LA COOKIE FUNCIONA A PARTIR DEL DIRECTORIO EN EL
   4 CUAL ESTE ESTE SCRIPT.
   5
   6 EL NOMBRE DE LA COOKIE DE PHP SE OBTIENE DE /etc/php4/apache/php.ini
   7 #]
   8 [-
   9 use CGI qw/:standard/;
  10 use CGI::Cookie;
  11
  12
  13 if (!defined($fdat{'redirect'})) {
  14     $http_headers_out {Location} = '/sistemas/intranet/';
  15     exit;
  16 }
  17
  18 %cookies = fetch CGI::Cookie;
  19 open FILE, '/etc/php4/apache/php.ini';
  20 while (<FILE>) {
  21     if (/session\.name\s*=\s*(\w+)/) {
  22         $cookie_name = $1;
  23         last;
  24     }
  25 }
  26 close FILE;
  27
  28 $archivo = '/tmp/sess_'.$cookies{$cookie_name}{'value'}[0];
  29
  30 open (FILE, $archivo);
  31 $linea = join ('',<FILE>);
  32 close FILE;
  33
  34 $res = parseSession (linea => $linea);
  35
  36 $udat{'user'}    = $res->{'user'};
  37 $udat{'domain'}  = $res->{'domain'};
  38 $udat{'nick'}    = $res->{'nick'};
  39 $udat{'nro_doc'} = $res->{'nro_doc'};
  40
  41 $http_headers_out {Location} = $fdat{'redirect'};
  42
  43 exit;
  44
  45 ################# FIN SCRIPT
  46
  47 sub parseSession
  48 {
  49     my %params = @_;
  50     my $op_value = $params{linea};
  51     my $pos = 0;
  52     my $name;
  53     my $type;
  54     my $type2;
  55     my $len;
  56     my $result;
  57
  58
  59
  60     while ($pos < 2){
  61
  62         #Obtengo el nombre del parametro
  63         $name     = substr($op_value, 0, index($op_value, '|'));
  64         $op_value = substr($op_value, index($op_value, '|') + 1); #Depuro la linea
  65         #Obtengo el tipo
  66         $type     = substr($op_value, 0, index($op_value, ':'));
  67         $type2    = substr($op_value, 0, index($op_value, ';'));
  68
  69         #Caso particular
  70         if ($type2 eq 'N') {
  71             $type = 'N';
  72             $op_value = substr($op_value, index($op_value, ';') + 1); #Depuro la linea
  73         }
  74         else {
  75             $op_value = substr($op_value, index($op_value, ':') + 1); #Depuro la linea
  76         }
  77
  78         if ($type eq 's') {
  79             #Obtengo la longitud
  80             $len = substr($op_value, 0, index($op_value, ':'));
  81             #Obtengo el resto de la linea
  82             $op_value = substr($op_value, index($op_value, ':') + 1);
  83             if ($name eq 'usuario') {
  84                 $result->{'user'} = substr($op_value, 1, $len);
  85                 ($result->{'nick'}, $result->{'domain'}) = split ('@', $result->{'user'});
  86                 $op_value = substr($op_value, $len + 3);
  87                 $pos++;
  88             }
  89             elsif ($name eq 'documento') {
  90                 $result->{'nro_doc'} = substr($op_value, 1, $len);
  91                 $pos++;
  92             }
  93             else {
  94                 $op_value = substr($op_value, $len + 3);
  95             }
  96         }
  97         elsif ($type eq 'i') {
  98             $op_value = substr($op_value, index($op_value,';') + 1);
  99         }
 100         elsif ($type eq 'd') {
 101             $op_value = substr($op_value, index($op_value,';') + 1);
 102         }
 103         elsif ($type eq 'b') {
 104             $op_value = substr($op_value, index($op_value,';') + 1);
 105         }
 106         elsif ($type eq 'a') {
 107             $op_value = parseContenido (cont => $op_value);
 108         }
 109         elsif ($type eq 'O') {
 110             $len = substr($op_value, 0, index($op_value,':'));
 111             $op_value = substr($op_value, index($op_value,':') + 1);
 112             $op_value = substr($op_value, $len + 3);
 113             $op_value = parseContenido (cont => $op_value);
 114         }
 115
 116         if (length($op_value) < 1) {
 117             $pos = 3;
 118         }
 119     }
 120     return $result;
 121 }
 122
 123 #Devuelve la linea sin el contenido
 124 sub parseContenido {
 125     my %params = @_;
 126     my $op_value = $params{cont};
 127     my $type;
 128     my $type2;
 129     my $len;
 130     my $seguir = 1;
 131
 132     #Elimino todo hasta el { inclusive
 133     $op_value = substr($op_value, index($op_value, ':') + 2);
 134
 135
 136     while ($seguir) {
 137         #Obtengo el tipo
 138         $type     = substr($op_value, 0, index($op_value, ':'));
 139         $type2    = substr($op_value, 0, index($op_value, ';')); #Caso particular Null
 140
 141         #Caso particular Null
 142         if ($type2 eq 'N') {
 143             $type = 'N';
 144             $op_value = substr($op_value, index($op_value, ';') + 1); #Depuro la linea
 145         }
 146         else {
 147             $op_value = substr($op_value, index($op_value, ':') + 1); #Depuro la linea
 148         }
 149         if ($type eq 's') {
 150             #Obtengo la longitud
 151             $len = substr($op_value, 0, index($op_value, ':'));
 152             #Obtengo el resto de la linea
 153             $op_value = substr($op_value, index($op_value, ':') + 1);
 154             $op_value = substr($op_value, $len + 3);
 155         }
 156         elsif ($type eq 'i') {
 157             $op_value = substr($op_value, index($op_value,';') + 1);
 158         }
 159         elsif($type eq 'd') {
 160             $op_value = substr($op_value, index($op_value,';') + 1);
 161         }
 162         elsif($type eq 'b') {
 163             $op_value = substr($op_value, index($op_value,';') + 1);
 164         }
 165         elsif($type eq 'a') {
 166             $op_value = parseContenido (cont => $op_value);
 167         }
 168         elsif($type eq 'O') {
 169             $op_value = parseContenido (cont => $op_value);
 170         }
 171
 172         if (substr($op_value,0,1) eq '}') {
 173             $op_value = substr($op_value,1);
 174             $seguir = 0;
 175         }
 176     }
 177     return $op_value;
 178 }
 179
 180 -]
 181 1;