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