Buenos días,
Explorer, probé el código que me distes en un archivo llamado prueba.pl, con todo igual y SÍ funciona.
Sin embargo, al incrustar ese código en el archivo que tiene el resto de la programación NO funciona.
Hay 2 cosas que debo señalarte del OPenCA:
1. Los archivos sí están programados en perl, pero tambien con XML... (es un tema para mí bastante complicado).
2. Los archivos no poseen extensiones ni usan el #!/usr/bin/perl , en la primera línea... cuando se llaman unos a otros en el url lo hacen a través del url más, por ejemplo cmd=index ...
Creo que mi problema mayor es que aun no comprendo bien el nucleo de la estructura del OPENCA.
Explorer, quiero ser clara en decir que no pretendo que en este foro me hagan entender el nucleo del OpenCa, solo pretendo que me ayuden a usar el perl para poder modificar la interfaz y los formularios para hacer la aplicación más amigable.
Voy a postear parte del código del archivo donde espero capturar los valores del url para ver si así es más fácil que me funcione lo que necesito.
Muchas gracias de antemano
Using perl Syntax Highlighting
## OpenCA - Public Web-Gateway Command
## (c) 1998-2001 by Massimiliano Pala and OpenCA Group
## (c) Copyright 2002-2004 The OpenCA Project
##
## File Name: basic_csr
## Brief: basic CSR
## Version: $Revision: 1.43.2.5 $
## Description: this script creates a CSR
## Parameters:
use strict
;
## holds the type of the request
sub cmdBasic_csr
{
our ($query, $config, $errval, $cryptoShell, $tools, $db);
my $minPinLength = getRequired
('minpinlength');
my $OPERATION = $query->param ('operation');
##our $type = $query->param ('CSR_TYPE');
our $type = "basic";
## read the loa.xml file and get the values
my $loaOption = getRequired
('USE_LOAS');
my ($loaTwig, $xmlLOA, %LOALevels, @LOANames, $loaHtml, $loaSelect, %LOAHash);
if ($loaOption =~ /yes/i)
{
$loaTwig = loadConfigXML
('LOAConfiguration');
if (not $loaTwig) {
generalError
(gettext
("Cannot load menu configration"));
}
for my $al ($loaTwig->get_xpath("loa"))
{
#$DEBUG=1;
$xmlLOA = gettext
(($al->first_child('name'))->field);
$LOALevels{$xmlLOA}=gettext
(($al->first_child('level'))->field);
$LOAHash{gettext
(($al->first_child('level'))->field)}=$xmlLOA;
push (@LOANames, $xmlLOA);
debug_cmds
("basic_csr: LOANames: ".@LOANames);
}
}
## check the submitted data to be consistent
if ( not checkBasic_csr
($OPERATION) ) {
## build the data
## load the normal DN and build the html-elements
my @elements = getRequiredList
("DN_TYPE_".$type."_ELEMENTS");
my @user_dn = (); # array with the user fields
## scan every element of the DN
for (my $i=1; $i <= scalar @elements; $i++) {
my $html;
my $input_check = "";
my $characterset = getRequired
("DN_TYPE_".$type."_ELEMENT_".$i."_CHARACTERSET");
my $optional = 0;
$optional = 1
if (getRequired
("DN_TYPE_".$type."_ELEMENT_".$i.'_REQUIRED') !~ /YES/i);
if ( defined $config->getParam ("DN_TYPE_".$type."_ELEMENT_".$i."_SELECT") ) {
my @h = getRequiredList
("DN_TYPE_".$type."_ELEMENT_".$i."_SELECT");
$html = $query->newInput (
-regx
=> $characterset,
-intype
=> 'popup_menu',
-name
=> 'DN_VALUE_'.$i,
-optional
=> $optional,
-value
=> \@h);
} elsif ( defined $config->getParam ("DN_TYPE_".$type."_ELEMENT_".$i."_XML_FILE") ) {
## load file
my $twig = loadConfigXML
("DN_TYPE_".$type."_ELEMENT_".$i."_XML_FILE");
## load path
my @fields = $twig->get_xpath (getRequired
("DN_TYPE_".$type."_ELEMENT_".$i."_XML_PATH"));
## setup array
my @field_array = ();
foreach my $field (@fields)
{
push @field_array, $field->field;
}
## build html
$html = $query->newInput (
-regx
=> $characterset,
-intype
=> 'popup_menu',
-name
=> 'DN_VALUE_'.$i,
-optional
=> $optional,
-value
=> \@field_array);
} else {
$html = $query->newInput (
-regx
=> $characterset,
-intype
=> 'textfield',
-size
=> 30,
-name
=> 'DN_VALUE_'.$i,
-optional
=> $optional,
-check
=> 'fill',
-minlen
=> getRequired
("DN_TYPE_".$type."_ELEMENT_".$i.'_MINIMUM_LENGTH'),
-value
=> $query->param ('DN_VALUE_'.$i));
}
push ( @user_dn, [
getRequired
("DN_TYPE_".$type."_ELEMENT_".$i),
$html
]);
}
## Subject Alternative Name Extension ## by oliwel
my @subjectalt_attr = getRequiredList
("DN_TYPE_".$type."_SUBJECTALTNAMES");
## scan every element of the DN
for (my $i=1; $i <= scalar @subjectalt_attr; $i++) {
my $html;
my $input_check = "";
my $optional = 0;
$optional = 1
if (getRequired
("DN_TYPE_".$type."_SUBJECTALTNAME_".$i.'_REQUIRED') !~ /YES/i);
if ( defined $config->getParam ("DN_TYPE_".$type."_SUBJECTALTNAME_".$i."_SELECT") ) {
my @h = getRequiredList
("DN_TYPE_".$type."_SUBJECTALTNAME_".$i."_SELECT");
$html = $query->newInput (
-regx
=> 'MIXED',
-intype
=> 'popup_menu',
-name
=> 'SUBJECTALTNAME_VALUE_'.$i,
-value
=> \@h);
} elsif ( defined $config->getParam ("DN_TYPE_".$type."_SUBJECTALTNAME_".$i."_XML_FILE") ) {
## load file
my $twig = loadConfigXML
("DN_TYPE_".$type."_SUBJECTALTNAME_".$i."_XML_FILE");
## load path
my @fields = $twig->get_xpath (getRequired
("DN_TYPE_".$type."_SUBJECTALTNAME_".$i."_XML_PATH"));
## setup array
my @field_array = ();
foreach my $field (@fields)
{
push @field_array, $field->field;
}
## build html
$html = $query->newInput (
-regx
=> 'MIXED',
-intype
=> 'popup_menu',
-name
=> 'SUBJECTALTNAME_VALUE_'.$i,
-optional
=> $optional,
-value
=> \@field_array);
} elsif ( $subjectalt_attr [$i-1] =~ /EMAIL/i ) {
$html = $query->newInput (
-regx
=> 'EMAIL',
-intype
=> 'textfield',
-size
=> 30,
-name
=> 'SUBJECTALTNAME_VALUE_'.$i,
-optional
=> $optional,
-check
=> 'fill',
-minlen
=> getRequired
("DN_TYPE_".$type."_SUBJECTALTNAME_".$i.'_MINIMUM_LENGTH'),
-value
=> $query->param ('SUBJECTALTNAME_VALUE_'.$i));
} else {
$html = $query->newInput (
-regx
=> 'LATIN1_LETTERS',
-intype
=> 'textfield',
-size
=> 30,
-name
=> 'SUBJECTALTNAME_VALUE_'.$i,
-optional
=> $optional,
-check
=> 'fill',
-minlen
=> getRequired
("DN_TYPE_".$type."_SUBJECTALTNAME_".$i.'_MINIMUM_LENGTH'),
-value
=> $query->param ('SUBJECTALTNAME_VALUE_'.$i));
}
push ( @user_dn, [
getRequired
("DN_TYPE_".$type."_SUBJECTALTNAME_".$i),
$html
]);
}
## end oliwel changes
Coloreado en 0.008 segundos, usando
GeSHi 1.0.8.4
AUN SIGUE PERO ES MUY EXTENSO...
Al final termina asi :
Using perl Syntax Highlighting
## remove trailing ","
$dn =~ s/,$//;
## microsoft uses E for emailaddress
$dn =~ s/,\s*emailAddress\s*=/,E=/i;
$dn =~ s/^\s*emailAddress\s*=/E=/i;
return $dn;
}
1;Coloreado en 0.001 segundos, usando
GeSHi 1.0.8.4
