sistema/www/Php2Embperl_Session.epl

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