From 9212a13878d2c6614483e0b6e9e68b8e6ece8996 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Mart=C3=ADn=20Marrese?= <marrese@gmail.com>
Date: Fri, 12 Sep 2003 18:15:08 +0000
Subject: [PATCH] Agrego el modulito que traduce la sesion de PHP a PERL. Hay
 que modificarlo en cada servidor, adaptando los redirect y los nombres de las
 cookies que tiene que levantar

---
 sistema/www/Php2Embperl_Session.epl | 165 ++++++++++++++++++++++++++++
 1 file changed, 165 insertions(+)
 create mode 100644 sistema/www/Php2Embperl_Session.epl

diff --git a/sistema/www/Php2Embperl_Session.epl b/sistema/www/Php2Embperl_Session.epl
new file mode 100644
index 0000000..5bae5f0
--- /dev/null
+++ b/sistema/www/Php2Embperl_Session.epl
@@ -0,0 +1,165 @@
+[-
+use CGI qw/:standard/;
+use CGI::Cookie;
+
+
+if (!defined($fdat{'redirect'})) {
+    $http_headers_out {Location} = 'http://bal747f.mecon.ar/sistemas/intranet';
+    exit;
+}
+                 
+
+%cookies = fetch CGI::Cookie;
+$archivo = '/tmp/sess_'.$cookies{'PHPSESSID747F'}{'value'}[0];
+
+open (FILE, $archivo);
+$linea = join ('',<FILE>);
+
+$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} = 'http://bal747f.mecon.ar/'.$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;
-- 
2.43.0