Tydy
This commit is contained in:
parent
aeead582d8
commit
f3c4ea0afb
|
@ -113,8 +113,8 @@ sub load {
|
||||||
$Lemonldap::NG::Common::Conf::msg .= "YAML fails to read file: $@ \n";
|
$Lemonldap::NG::Common::Conf::msg .= "YAML fails to read file: $@ \n";
|
||||||
return undef;
|
return undef;
|
||||||
}
|
}
|
||||||
foreach (keys %$ret) {
|
foreach ( keys %$ret ) {
|
||||||
if($_ =~ $boolKeys) {
|
if ( $_ =~ $boolKeys ) {
|
||||||
$ret->{$_} = $ret->{$_} ? 1 : 0;
|
$ret->{$_} = $ret->{$_} ? 1 : 0;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -53,7 +53,7 @@ sub serviceToXML {
|
||||||
$template->param( $_, $self->getValue( $_, $conf ) );
|
$template->param( $_, $self->getValue( $_, $conf ) );
|
||||||
}
|
}
|
||||||
|
|
||||||
# When asked to provide only IDP metadata, take into account EntityID override
|
# When asked to provide only IDP metadata, take into account EntityID override
|
||||||
if ( $type eq "idp" and $conf->{samlOverrideIDPEntityID} ) {
|
if ( $type eq "idp" and $conf->{samlOverrideIDPEntityID} ) {
|
||||||
$template->param( 'samlEntityID', $conf->{samlOverrideIDPEntityID} );
|
$template->param( 'samlEntityID', $conf->{samlOverrideIDPEntityID} );
|
||||||
}
|
}
|
||||||
|
|
|
@ -141,7 +141,9 @@ sub BUILD {
|
||||||
if ($data) {
|
if ($data) {
|
||||||
if ( $self->kind and $data->{_session_kind} ) {
|
if ( $self->kind and $data->{_session_kind} ) {
|
||||||
unless ( $data->{_session_kind} eq $self->kind ) {
|
unless ( $data->{_session_kind} eq $self->kind ) {
|
||||||
$self->error("Session kind mismatch : $data->{_session_kind} is not ".$self->kind );
|
$self->error(
|
||||||
|
"Session kind mismatch : $data->{_session_kind} is not "
|
||||||
|
. $self->kind );
|
||||||
return undef;
|
return undef;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -140,14 +140,15 @@ sub tplParams {
|
||||||
|
|
||||||
sub javascript {
|
sub javascript {
|
||||||
my ( $self, $req ) = @_;
|
my ( $self, $req ) = @_;
|
||||||
my $res = $self->diffRule->( $req, $req->{userData} ) || 0;
|
my $res = $self->diffRule->( $req, $req->{userData} ) || 0;
|
||||||
my $impPrefix = $self->{impersonationPrefix};
|
my $impPrefix = $self->{impersonationPrefix};
|
||||||
my $ttl = $self->{timeout} || 72000;
|
my $ttl = $self->{timeout} || 72000;
|
||||||
|
|
||||||
return
|
return
|
||||||
'var formPrefix=staticPrefix+"forms/";var confPrefix=scriptname+"confs/";var viewPrefix=scriptname+"view/";'
|
'var formPrefix=staticPrefix+"forms/";var confPrefix=scriptname+"confs/";var viewPrefix=scriptname+"view/";'
|
||||||
. 'var allowDiff=' . "$res;"
|
. 'var allowDiff=' . "$res;"
|
||||||
. 'var impPrefix=' . "'" . $impPrefix . "'" . ';'
|
. 'var impPrefix=' . "'"
|
||||||
|
. $impPrefix . "'" . ';'
|
||||||
. 'var sessionTTL=' . "$ttl;"
|
. 'var sessionTTL=' . "$ttl;"
|
||||||
. ( $self->links ? 'var links=' . to_json( $self->links ) . ';' : '' )
|
. ( $self->links ? 'var links=' . to_json( $self->links ) . ';' : '' )
|
||||||
. (
|
. (
|
||||||
|
|
|
@ -70,7 +70,7 @@ has confChanged => (
|
||||||
);
|
);
|
||||||
|
|
||||||
# Properties required during build
|
# Properties required during build
|
||||||
has refConf => ( is => 'ro', isa => 'HashRef', required => 1 );
|
has refConf => ( is => 'ro', isa => 'HashRef', required => 1 );
|
||||||
has req => ( is => 'ro', required => 1 );
|
has req => ( is => 'ro', required => 1 );
|
||||||
has newConf => ( is => 'rw', isa => 'HashRef' );
|
has newConf => ( is => 'rw', isa => 'HashRef' );
|
||||||
has tree => ( is => 'rw', isa => 'ArrayRef' );
|
has tree => ( is => 'rw', isa => 'ArrayRef' );
|
||||||
|
@ -160,7 +160,7 @@ sub _scanNodes {
|
||||||
hdebug("Looking to $name");
|
hdebug("Looking to $name");
|
||||||
|
|
||||||
# subnode
|
# subnode
|
||||||
my $subNodes = $leaf->{nodes} // $leaf->{_nodes};
|
my $subNodes = $leaf->{nodes} // $leaf->{_nodes};
|
||||||
my $subNodesCond = $leaf->{nodes_cond} // $leaf->{_nodes_cond};
|
my $subNodesCond = $leaf->{nodes_cond} // $leaf->{_nodes_cond};
|
||||||
|
|
||||||
##################################
|
##################################
|
||||||
|
@ -1070,14 +1070,14 @@ sub _unitTest {
|
||||||
or $attr->{type} =~ /Container$/ )
|
or $attr->{type} =~ /Container$/ )
|
||||||
{
|
{
|
||||||
my $keyMsg = $attr->{keyMsgFail} // $type->{keyMsgFail};
|
my $keyMsg = $attr->{keyMsgFail} // $type->{keyMsgFail};
|
||||||
my $msg = $attr->{msgFail} // $type->{msgFail};
|
my $msg = $attr->{msgFail} // $type->{msgFail};
|
||||||
$res = 0
|
$res = 0
|
||||||
unless (
|
unless (
|
||||||
$self->_execTest( {
|
$self->_execTest( {
|
||||||
keyTest => $attr->{keyTest} // $type->{keyTest},
|
keyTest => $attr->{keyTest} // $type->{keyTest},
|
||||||
keyMsgFail => $attr->{keyMsgFail}
|
keyMsgFail => $attr->{keyMsgFail}
|
||||||
// $type->{keyMsgFail},
|
// $type->{keyMsgFail},
|
||||||
test => $attr->{test} // $type->{test},
|
test => $attr->{test} // $type->{test},
|
||||||
msgFail => $attr->{msgFail} // $type->{msgFail},
|
msgFail => $attr->{msgFail} // $type->{msgFail},
|
||||||
},
|
},
|
||||||
$conf->{$key},
|
$conf->{$key},
|
||||||
|
|
|
@ -646,7 +646,8 @@ sub tests {
|
||||||
# Warn if Impersonation is enabled without prefix
|
# Warn if Impersonation is enabled without prefix
|
||||||
impersonationPrefix => sub {
|
impersonationPrefix => sub {
|
||||||
return 1 unless ( $conf->{impersonationRule} );
|
return 1 unless ( $conf->{impersonationRule} );
|
||||||
return ( 1, "Impersonation is enabled without real attributes prefix" )
|
return ( 1,
|
||||||
|
"Impersonation is enabled without real attributes prefix" )
|
||||||
unless ( $conf->{impersonationPrefix} );
|
unless ( $conf->{impersonationPrefix} );
|
||||||
|
|
||||||
# Return
|
# Return
|
||||||
|
|
|
@ -149,8 +149,8 @@ sub zeroConf {
|
||||||
'locationRules' => {
|
'locationRules' => {
|
||||||
"auth.$domain" => {
|
"auth.$domain" => {
|
||||||
'(?#checkUser)^/checkuser' => '$uid eq "dwho"',
|
'(?#checkUser)^/checkuser' => '$uid eq "dwho"',
|
||||||
'(?#errors)^/lmerror/' => 'accept',
|
'(?#errors)^/lmerror/' => 'accept',
|
||||||
'default' => 'accept'
|
'default' => 'accept'
|
||||||
},
|
},
|
||||||
"test1.$domain" => {
|
"test1.$domain" => {
|
||||||
'default' => 'accept',
|
'default' => 'accept',
|
||||||
|
@ -162,7 +162,8 @@ sub zeroConf {
|
||||||
},
|
},
|
||||||
"manager.$domain" => {
|
"manager.$domain" => {
|
||||||
'default' => '$uid eq "dwho" or $uid eq "rtyler"',
|
'default' => '$uid eq "dwho" or $uid eq "rtyler"',
|
||||||
'(?#Configuration)^/(manager\.html|confs|$)' => '$uid eq "dwho"',
|
'(?#Configuration)^/(manager\.html|confs|$)' =>
|
||||||
|
'$uid eq "dwho"',
|
||||||
'(?#Sessions)/sessions' => '$uid eq "dwho" or $uid eq "rtyler"',
|
'(?#Sessions)/sessions' => '$uid eq "dwho" or $uid eq "rtyler"',
|
||||||
'(?#Notifications)/notifications' =>
|
'(?#Notifications)/notifications' =>
|
||||||
'$uid eq "dwho" or $uid eq "rtyler"',
|
'$uid eq "dwho" or $uid eq "rtyler"',
|
||||||
|
|
|
@ -53,7 +53,7 @@ sub addRoutes {
|
||||||
|
|
||||||
$self->{ipField} ||= 'ipAddr';
|
$self->{ipField} ||= 'ipAddr';
|
||||||
$self->{multiValuesSeparator} ||= '; ';
|
$self->{multiValuesSeparator} ||= '; ';
|
||||||
$self->{impersonationPrefix} = $conf->{impersonationPrefix} || 'real_';
|
$self->{impersonationPrefix} = $conf->{impersonationPrefix} || 'real_';
|
||||||
$self->{hiddenAttributes} //= "_password";
|
$self->{hiddenAttributes} //= "_password";
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -6,9 +6,8 @@ use strict;
|
||||||
use JSON;
|
use JSON;
|
||||||
require 't/test-lib.pm';
|
require 't/test-lib.pm';
|
||||||
|
|
||||||
my @struct =
|
my @struct = qw[t/jsonfiles/03-base-tree-appCat-modifed.json];
|
||||||
qw[t/jsonfiles/03-base-tree-appCat-modifed.json];
|
my @desc = ('Changed conf with deleted Category');
|
||||||
my @desc = ( 'Changed conf with deleted Category' );
|
|
||||||
my $confFiles = [ 't/conf/lmConf-1.json', 't/conf/lmConf-2.json' ];
|
my $confFiles = [ 't/conf/lmConf-1.json', 't/conf/lmConf-2.json' ];
|
||||||
|
|
||||||
sub body {
|
sub body {
|
||||||
|
@ -42,15 +41,21 @@ while ( my $body = &body() ) {
|
||||||
ok( @{ $resBody->{details}->{__changes__} } eq 1,
|
ok( @{ $resBody->{details}->{__changes__} } eq 1,
|
||||||
"$desc: conf has changed" )
|
"$desc: conf has changed" )
|
||||||
or print STDERR Dumper($resBody);
|
or print STDERR Dumper($resBody);
|
||||||
ok( $resBody->{details}->{__changes__}->[0]->{new} eq 'categoryList, Administration, Documentation',
|
ok(
|
||||||
"$desc: new key received" )
|
$resBody->{details}->{__changes__}->[0]->{new} eq
|
||||||
or print STDERR Dumper($resBody);
|
'categoryList, Administration, Documentation',
|
||||||
ok( $resBody->{details}->{__changes__}->[0]->{old} eq 'categoryList, Administration, Documentation, Sample applications',
|
"$desc: new key received"
|
||||||
"$desc: old key received" )
|
) or print STDERR Dumper($resBody);
|
||||||
or print STDERR Dumper($resBody);
|
ok(
|
||||||
ok( $resBody->{details}->{__changes__}->[0]->{key} eq 'Deletes in cat(s), Sample applications',
|
$resBody->{details}->{__changes__}->[0]->{old} eq
|
||||||
"$desc: key received" )
|
'categoryList, Administration, Documentation, Sample applications',
|
||||||
or print STDERR Dumper($resBody);
|
"$desc: old key received"
|
||||||
|
) or print STDERR Dumper($resBody);
|
||||||
|
ok(
|
||||||
|
$resBody->{details}->{__changes__}->[0]->{key} eq
|
||||||
|
'Deletes in cat(s), Sample applications',
|
||||||
|
"$desc: key received"
|
||||||
|
) or print STDERR Dumper($resBody);
|
||||||
ok( -e $confFiles->[1], "$desc: file is created" );
|
ok( -e $confFiles->[1], "$desc: file is created" );
|
||||||
|
|
||||||
#print STDERR Dumper($resBody);
|
#print STDERR Dumper($resBody);
|
||||||
|
|
|
@ -64,7 +64,7 @@ count(2);
|
||||||
# Try to display previous conf
|
# Try to display previous conf
|
||||||
$res = &client->jsonResponse('/view/1');
|
$res = &client->jsonResponse('/view/1');
|
||||||
ok( $res->{cfgNum} eq '1', 'Browser is allowed' )
|
ok( $res->{cfgNum} eq '1', 'Browser is allowed' )
|
||||||
or print STDERR Dumper($res);
|
or print STDERR Dumper($res);
|
||||||
count(1);
|
count(1);
|
||||||
|
|
||||||
# Remove new conf
|
# Remove new conf
|
||||||
|
|
|
@ -305,7 +305,7 @@ sub run {
|
||||||
$self->logger->debug(
|
$self->logger->debug(
|
||||||
"Delete 2F Device : { type => 'TOTP', epoch => $epoch }");
|
"Delete 2F Device : { type => 'TOTP', epoch => $epoch }");
|
||||||
$self->p->updatePersistentSession( $req,
|
$self->p->updatePersistentSession( $req,
|
||||||
{ _2fDevices => to_json( $_2fDevices ) } );
|
{ _2fDevices => to_json($_2fDevices) } );
|
||||||
$self->userLogger->notice('TOTP deletion succeed');
|
$self->userLogger->notice('TOTP deletion succeed');
|
||||||
return [
|
return [
|
||||||
200,
|
200,
|
||||||
|
|
|
@ -292,7 +292,7 @@ sub run {
|
||||||
$self->logger->debug(
|
$self->logger->debug(
|
||||||
"Delete 2F Device : { type => 'U2F', epoch => $epoch }");
|
"Delete 2F Device : { type => 'U2F', epoch => $epoch }");
|
||||||
$self->p->updatePersistentSession( $req,
|
$self->p->updatePersistentSession( $req,
|
||||||
{ _2fDevices => to_json( $_2fDevices ) } );
|
{ _2fDevices => to_json($_2fDevices) } );
|
||||||
$self->userLogger->notice('U2F key unregistration succeed');
|
$self->userLogger->notice('U2F key unregistration succeed');
|
||||||
return [
|
return [
|
||||||
200,
|
200,
|
||||||
|
|
|
@ -186,7 +186,7 @@ sub run {
|
||||||
$self->logger->debug(
|
$self->logger->debug(
|
||||||
"Delete 2F Device : { type => 'UBK', epoch => $epoch }");
|
"Delete 2F Device : { type => 'UBK', epoch => $epoch }");
|
||||||
$self->p->updatePersistentSession( $req,
|
$self->p->updatePersistentSession( $req,
|
||||||
{ _2fDevices => to_json( $_2fDevices ) } );
|
{ _2fDevices => to_json($_2fDevices) } );
|
||||||
$self->userLogger->notice('Yubikey deletion succeed');
|
$self->userLogger->notice('Yubikey deletion succeed');
|
||||||
return [
|
return [
|
||||||
200,
|
200,
|
||||||
|
|
|
@ -142,7 +142,7 @@ sub authenticate {
|
||||||
|
|
||||||
sub setAuthSessionInfo {
|
sub setAuthSessionInfo {
|
||||||
my ( $self, $req ) = @_;
|
my ( $self, $req ) = @_;
|
||||||
$req->sessionInfo->{gpgMail} = $req->data->{gpgMail};
|
$req->sessionInfo->{gpgMail} = $req->data->{gpgMail};
|
||||||
$req->sessionInfo->{authenticationLevel} = $self->conf->{gpgAuthnLevel};
|
$req->sessionInfo->{authenticationLevel} = $self->conf->{gpgAuthnLevel};
|
||||||
PE_OK;
|
PE_OK;
|
||||||
}
|
}
|
||||||
|
|
|
@ -16,7 +16,7 @@ extends 'Lemonldap::NG::Portal::Main::Auth',
|
||||||
|
|
||||||
# INTERFACE
|
# INTERFACE
|
||||||
|
|
||||||
has opList => ( is => 'rw', default => sub { [] } );
|
has opList => ( is => 'rw', default => sub { [] } );
|
||||||
has opNumber => ( is => 'rw', default => 0 );
|
has opNumber => ( is => 'rw', default => 0 );
|
||||||
has path => ( is => 'rw', default => 'oauth2' );
|
has path => ( is => 'rw', default => 'oauth2' );
|
||||||
|
|
||||||
|
@ -34,7 +34,7 @@ sub init {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
$self->opNumber( scalar @tab );
|
$self->opNumber( scalar @tab );
|
||||||
my @list = ();
|
my @list = ();
|
||||||
my $portalPath = $self->conf->{portal};
|
my $portalPath = $self->conf->{portal};
|
||||||
|
|
||||||
foreach (@tab) {
|
foreach (@tab) {
|
||||||
|
|
|
@ -184,7 +184,7 @@ sub send_mail {
|
||||||
foreach ( keys %cid ) {
|
foreach ( keys %cid ) {
|
||||||
$message->attach(
|
$message->attach(
|
||||||
Type => "image/" . ( $cid{$_} =~ m/\.(\w+)/ )[0],
|
Type => "image/" . ( $cid{$_} =~ m/\.(\w+)/ )[0],
|
||||||
Id => $_,
|
Id => $_,
|
||||||
Path => $self->conf->{templateDir} . "/"
|
Path => $self->conf->{templateDir} . "/"
|
||||||
. $self->conf->{portalSkin} . "/"
|
. $self->conf->{portalSkin} . "/"
|
||||||
. $cid{$_},
|
. $cid{$_},
|
||||||
|
|
|
@ -113,7 +113,7 @@ sub display {
|
||||||
&& $req->data->{login},
|
&& $req->data->{login},
|
||||||
ASK_LOGINS => $req->param('checkLogins') || 0,
|
ASK_LOGINS => $req->param('checkLogins') || 0,
|
||||||
CONFIRMKEY => $self->stamp(),
|
CONFIRMKEY => $self->stamp(),
|
||||||
LIST => $req->data->{list} || [],
|
LIST => $req->data->{list} || [],
|
||||||
REMEMBER => $req->data->{confirmRemember},
|
REMEMBER => $req->data->{confirmRemember},
|
||||||
(
|
(
|
||||||
$req->data->{customScript}
|
$req->data->{customScript}
|
||||||
|
|
|
@ -113,7 +113,7 @@ sub _redirect {
|
||||||
delete $req->pdata->{ $self->ipath };
|
delete $req->pdata->{ $self->ipath };
|
||||||
delete $req->pdata->{ $self->ipath . 'Path' };
|
delete $req->pdata->{ $self->ipath . 'Path' };
|
||||||
return $self->run( @_, @path );
|
return $self->run( @_, @path );
|
||||||
}
|
}
|
||||||
: ()
|
: ()
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
|
|
|
@ -57,7 +57,8 @@ sub run {
|
||||||
my ( $self, $req ) = @_;
|
my ( $self, $req ) = @_;
|
||||||
my $savedHttpSession = $req->{sessionInfo}->{_httpSession} //= '';
|
my $savedHttpSession = $req->{sessionInfo}->{_httpSession} //= '';
|
||||||
my $spoofId = $req->param('spoofId') || $req->{user};
|
my $spoofId = $req->param('spoofId') || $req->{user};
|
||||||
$self->logger->debug("No impersonation required") if ( $spoofId eq $req->{user} );
|
$self->logger->debug("No impersonation required")
|
||||||
|
if ( $spoofId eq $req->{user} );
|
||||||
my $statut = PE_OK;
|
my $statut = PE_OK;
|
||||||
|
|
||||||
if ( $spoofId !~ /$self->{conf}->{userControl}/o ) {
|
if ( $spoofId !~ /$self->{conf}->{userControl}/o ) {
|
||||||
|
@ -141,7 +142,8 @@ sub run {
|
||||||
$req->steps( [ $self->p->validSession, @{ $self->p->endAuth } ] );
|
$req->steps( [ $self->p->validSession, @{ $self->p->endAuth } ] );
|
||||||
|
|
||||||
# Restore _httpSession for double Cookies
|
# Restore _httpSession for double Cookies
|
||||||
$req->{sessionInfo}->{_httpSession} = $savedHttpSession if $savedHttpSession;
|
$req->{sessionInfo}->{_httpSession} = $savedHttpSession
|
||||||
|
if $savedHttpSession;
|
||||||
return $statut;
|
return $statut;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -207,4 +209,4 @@ sub _userDatas {
|
||||||
return $req->{sessionInfo};
|
return $req->{sessionInfo};
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
@ -165,7 +165,7 @@ sub _register {
|
||||||
and
|
and
|
||||||
!$self->getRegisterSession( $req->data->{registerInfo}->{mail} ) )
|
!$self->getRegisterSession( $req->data->{registerInfo}->{mail} ) )
|
||||||
{
|
{
|
||||||
|
|
||||||
# Check if token exists
|
# Check if token exists
|
||||||
my $token;
|
my $token;
|
||||||
if ( $self->ottRule->( $req, {} ) or $self->captcha ) {
|
if ( $self->ottRule->( $req, {} ) or $self->captcha ) {
|
||||||
|
|
|
@ -41,10 +41,9 @@ ok(
|
||||||
'Auth query'
|
'Auth query'
|
||||||
);
|
);
|
||||||
count(1);
|
count(1);
|
||||||
ok(
|
ok( $res->[2]->[0] =~ /<span trmsg="5"><\/span><\/div>/,
|
||||||
$res->[2]->[0] =~ /<span trmsg="5"><\/span><\/div>/,
|
'jdoe rejected with PE_BADCREDENTIALS' )
|
||||||
'jdoe rejected with PE_BADCREDENTIALS'
|
or print STDERR Dumper( $res->[2]->[0] );
|
||||||
) or print STDERR Dumper( $res->[2]->[0] );
|
|
||||||
count(1);
|
count(1);
|
||||||
ok( $res->[2]->[0] =~ m%<span trspan="connect">Connect</span>%,
|
ok( $res->[2]->[0] =~ m%<span trspan="connect">Connect</span>%,
|
||||||
'Found connect button' )
|
'Found connect button' )
|
||||||
|
@ -63,17 +62,15 @@ ok(
|
||||||
'Auth query'
|
'Auth query'
|
||||||
);
|
);
|
||||||
count(1);
|
count(1);
|
||||||
ok(
|
ok( $res->[2]->[0] =~ /<span trmsg="5"><\/span><\/div>/,
|
||||||
$res->[2]->[0] =~ /<span trmsg="5"><\/span><\/div>/,
|
'dwho rejected with PE_BADCREDENTIALS' )
|
||||||
'dwho rejected with PE_BADCREDENTIALS'
|
or print STDERR Dumper( $res->[2]->[0] );
|
||||||
) or print STDERR Dumper( $res->[2]->[0] );
|
|
||||||
count(1);
|
count(1);
|
||||||
ok( $res->[2]->[0] =~ m%<span trspan="connect">Connect</span>%,
|
ok( $res->[2]->[0] =~ m%<span trspan="connect">Connect</span>%,
|
||||||
'Found connect button' )
|
'Found connect button' )
|
||||||
or print STDERR Dumper( $res->[2]->[0] );
|
or print STDERR Dumper( $res->[2]->[0] );
|
||||||
count(1);
|
count(1);
|
||||||
|
|
||||||
|
|
||||||
# Try to authenticate with good password
|
# Try to authenticate with good password
|
||||||
# --------------------------------------
|
# --------------------------------------
|
||||||
ok(
|
ok(
|
||||||
|
|
|
@ -106,8 +106,7 @@ SKIP: {
|
||||||
$dbh->do(
|
$dbh->do(
|
||||||
"INSERT INTO users VALUES ('jsmith','{ssha512}wr0zU/I6f7U4bVoeOlJnNFbhF0a9np59LUeNnhokohVI/wiNzt8Y4JujfOfNQiGuiVgY+xrYggfmgpke6KdjxKS7W0GR1ZCe','John Smith')"
|
"INSERT INTO users VALUES ('jsmith','{ssha512}wr0zU/I6f7U4bVoeOlJnNFbhF0a9np59LUeNnhokohVI/wiNzt8Y4JujfOfNQiGuiVgY+xrYggfmgpke6KdjxKS7W0GR1ZCe','John Smith')"
|
||||||
);
|
);
|
||||||
my $client = LLNG::Manager::Test->new(
|
my $client = LLNG::Manager::Test->new( {
|
||||||
{
|
|
||||||
ini => {
|
ini => {
|
||||||
logLevel => 'error',
|
logLevel => 'error',
|
||||||
useSafeJail => 1,
|
useSafeJail => 1,
|
||||||
|
|
|
@ -7,7 +7,7 @@ require 't/test-lib.pm';
|
||||||
my $mainTests = 5;
|
my $mainTests = 5;
|
||||||
|
|
||||||
SKIP: {
|
SKIP: {
|
||||||
skip "Manual skip of GPG test", $mainTests if ($ENV{LLNG_SKIP_GPG_TEST});
|
skip "Manual skip of GPG test", $mainTests if ( $ENV{LLNG_SKIP_GPG_TEST} );
|
||||||
eval "use IPC::Run 'run',";
|
eval "use IPC::Run 'run',";
|
||||||
skip "Missing dependency", $mainTests if ($@);
|
skip "Missing dependency", $mainTests if ($@);
|
||||||
my $gpg = `which gpg`;
|
my $gpg = `which gpg`;
|
||||||
|
|
|
@ -67,10 +67,13 @@ SKIP: {
|
||||||
|
|
||||||
# IDP must be sorted
|
# IDP must be sorted
|
||||||
my @idp = map /val="http:\/\/(.+?)\/saml\/metadata">/g, $res->[2]->[0];
|
my @idp = map /val="http:\/\/(.+?)\/saml\/metadata">/g, $res->[2]->[0];
|
||||||
ok( $idp[0] eq 'auth.idp2.com', '1st = idp2' ) or print STDERR Dumper( \@idp );
|
ok( $idp[0] eq 'auth.idp2.com', '1st = idp2' )
|
||||||
ok( $idp[1] eq 'auth.idp2_z.com', '2nd = idp2_z' ) or print STDERR Dumper( \@idp );
|
or print STDERR Dumper( \@idp );
|
||||||
ok( $idp[2] eq 'auth.idp3.com', '3rd = idp3' ) or print STDERR Dumper( \@idp );
|
ok( $idp[1] eq 'auth.idp2_z.com', '2nd = idp2_z' )
|
||||||
ok( $idp[3] eq 'auth.idp.com', '4th= idp' ) or print STDERR Dumper( \@idp );
|
or print STDERR Dumper( \@idp );
|
||||||
|
ok( $idp[2] eq 'auth.idp3.com', '3rd = idp3' )
|
||||||
|
or print STDERR Dumper( \@idp );
|
||||||
|
ok( $idp[3] eq 'auth.idp.com', '4th= idp' ) or print STDERR Dumper( \@idp );
|
||||||
|
|
||||||
ok(
|
ok(
|
||||||
$res->[2]->[0] =~
|
$res->[2]->[0] =~
|
||||||
|
|
|
@ -132,7 +132,7 @@ m#img src="http://auth.idp.com(/saml/relaySingleLogoutSOAP)\?(relay=.*?)"#s,
|
||||||
),
|
),
|
||||||
'Get image'
|
'Get image'
|
||||||
);
|
);
|
||||||
expectRedirection( $res, "http://auth.idp.com/static/common/icons/ok.png");
|
expectRedirection( $res, "http://auth.idp.com/static/common/icons/ok.png" );
|
||||||
|
|
||||||
# Test if logout is done
|
# Test if logout is done
|
||||||
switch ('issuer');
|
switch ('issuer');
|
||||||
|
|
|
@ -27,12 +27,19 @@ SKIP: {
|
||||||
|
|
||||||
ok( $res = $issuer->_get('/saml/metadata/idp'), 'Get IDP metadata' );
|
ok( $res = $issuer->_get('/saml/metadata/idp'), 'Get IDP metadata' );
|
||||||
ok( $res->[2]->[0] =~ m#^<\?xml version="1.0"\?>#s, 'Metadata is XML' );
|
ok( $res->[2]->[0] =~ m#^<\?xml version="1.0"\?>#s, 'Metadata is XML' );
|
||||||
ok( $res->[2]->[0] !~ m#<SPSSODescriptor#s, 'Metadata does not contain SP information' );
|
ok(
|
||||||
ok( $res->[2]->[0] =~ m#entityID="urn:example\.com"#s, 'IDP EntityID is overriden' );
|
$res->[2]->[0] !~ m#<SPSSODescriptor#s,
|
||||||
|
'Metadata does not contain SP information'
|
||||||
|
);
|
||||||
|
ok( $res->[2]->[0] =~ m#entityID="urn:example\.com"#s,
|
||||||
|
'IDP EntityID is overriden' );
|
||||||
|
|
||||||
ok( $res = $issuer->_get('/saml/metadata/sp'), 'Get SP metadata' );
|
ok( $res = $issuer->_get('/saml/metadata/sp'), 'Get SP metadata' );
|
||||||
ok( $res->[2]->[0] =~ m#^<\?xml version="1.0"\?>#s, 'Metadata is XML' );
|
ok( $res->[2]->[0] =~ m#^<\?xml version="1.0"\?>#s, 'Metadata is XML' );
|
||||||
ok( $res->[2]->[0] !~ m#<IDPSSODescriptor#s, 'Metadata does not contain IDP information' );
|
ok(
|
||||||
|
$res->[2]->[0] !~ m#<IDPSSODescriptor#s,
|
||||||
|
'Metadata does not contain IDP information'
|
||||||
|
);
|
||||||
|
|
||||||
#print STDERR Dumper($res);
|
#print STDERR Dumper($res);
|
||||||
}
|
}
|
||||||
|
@ -44,14 +51,14 @@ done_testing( count() );
|
||||||
sub issuer {
|
sub issuer {
|
||||||
return LLNG::Manager::Test->new( {
|
return LLNG::Manager::Test->new( {
|
||||||
ini => {
|
ini => {
|
||||||
logLevel => $debug,
|
logLevel => $debug,
|
||||||
domain => 'idp.com',
|
domain => 'idp.com',
|
||||||
portal => 'http://auth.idp.com',
|
portal => 'http://auth.idp.com',
|
||||||
authentication => 'Demo',
|
authentication => 'Demo',
|
||||||
userDB => 'Same',
|
userDB => 'Same',
|
||||||
issuerDBSAMLActivation => 1,
|
issuerDBSAMLActivation => 1,
|
||||||
samlOverrideIDPEntityID => 'urn:example.com',
|
samlOverrideIDPEntityID => 'urn:example.com',
|
||||||
samlSPMetaDataOptions => {
|
samlSPMetaDataOptions => {
|
||||||
'sp.com' => {
|
'sp.com' => {
|
||||||
samlSPMetaDataOptionsEncryptionMode => 'none',
|
samlSPMetaDataOptionsEncryptionMode => 'none',
|
||||||
samlSPMetaDataOptionsSignSSOMessage => 1,
|
samlSPMetaDataOptionsSignSSOMessage => 1,
|
||||||
|
|
|
@ -141,7 +141,7 @@ m#iframe src="http://auth.sp.com(/saml/proxySingleLogout)\?(SAMLRequest=.*?)"#,
|
||||||
switch ('issuer');
|
switch ('issuer');
|
||||||
ok( $res = $issuer->_get( $url, query => $query, accept => 'text/html' ),
|
ok( $res = $issuer->_get( $url, query => $query, accept => 'text/html' ),
|
||||||
'Push SAML response to IdP' );
|
'Push SAML response to IdP' );
|
||||||
expectRedirection($res, 'http://auth.idp.com/static/common/icons/ok.png');
|
expectRedirection( $res, 'http://auth.idp.com/static/common/icons/ok.png' );
|
||||||
ok( getHeader( $res, 'Content-Security-Policy' ) !~ /frame-ancestors/,
|
ok( getHeader( $res, 'Content-Security-Policy' ) !~ /frame-ancestors/,
|
||||||
' Frame can be embedded' )
|
' Frame can be embedded' )
|
||||||
or explain( $res->[1],
|
or explain( $res->[1],
|
||||||
|
|
|
@ -341,13 +341,13 @@ sub op {
|
||||||
oidcServiceAllowAuthorizationCodeFlow => 1,
|
oidcServiceAllowAuthorizationCodeFlow => 1,
|
||||||
oidcRPMetaDataOptions => {
|
oidcRPMetaDataOptions => {
|
||||||
rp => {
|
rp => {
|
||||||
oidcRPMetaDataOptionsDisplayName => "RP",
|
oidcRPMetaDataOptionsDisplayName => "RP",
|
||||||
oidcRPMetaDataOptionsIDTokenExpiration => 3600,
|
oidcRPMetaDataOptionsIDTokenExpiration => 3600,
|
||||||
oidcRPMetaDataOptionsClientID => "rpid",
|
oidcRPMetaDataOptionsClientID => "rpid",
|
||||||
oidcRPMetaDataOptionsIDTokenSignAlg => "RS512",
|
oidcRPMetaDataOptionsIDTokenSignAlg => "RS512",
|
||||||
oidcRPMetaDataOptionsBypassConsent => 0,
|
oidcRPMetaDataOptionsBypassConsent => 0,
|
||||||
oidcRPMetaDataOptionsPublic => 1,
|
oidcRPMetaDataOptionsPublic => 1,
|
||||||
oidcRPMetaDataOptionsUserIDAttr => "",
|
oidcRPMetaDataOptionsUserIDAttr => "",
|
||||||
oidcRPMetaDataOptionsAccessTokenExpiration => 3600,
|
oidcRPMetaDataOptionsAccessTokenExpiration => 3600,
|
||||||
oidcRPMetaDataOptionsPostLogoutRedirectUris =>
|
oidcRPMetaDataOptionsPostLogoutRedirectUris =>
|
||||||
"http://auth.rp.com/?logout=1"
|
"http://auth.rp.com/?logout=1"
|
||||||
|
|
|
@ -80,7 +80,7 @@ expectOK($res);
|
||||||
my $metadata = $res->[2]->[0];
|
my $metadata = $res->[2]->[0];
|
||||||
count(3);
|
count(3);
|
||||||
|
|
||||||
switch('rp');
|
switch ('rp');
|
||||||
&Lemonldap::NG::Handler::Main::cfgNum( 0, 0 );
|
&Lemonldap::NG::Handler::Main::cfgNum( 0, 0 );
|
||||||
ok( $rp = rp( $jwks, $metadata ), 'RP portal' );
|
ok( $rp = rp( $jwks, $metadata ), 'RP portal' );
|
||||||
count(1);
|
count(1);
|
||||||
|
|
|
@ -76,7 +76,7 @@ sub iniCmb {
|
||||||
useSafeJail => 1,
|
useSafeJail => 1,
|
||||||
authentication => 'Combination',
|
authentication => 'Combination',
|
||||||
userDB => 'Same',
|
userDB => 'Same',
|
||||||
|
|
||||||
combination => $expr,
|
combination => $expr,
|
||||||
combModules => {
|
combModules => {
|
||||||
DB => {
|
DB => {
|
||||||
|
|
|
@ -116,7 +116,7 @@ SKIP: {
|
||||||
query => $query,
|
query => $query,
|
||||||
accept => 'text/html',
|
accept => 'text/html',
|
||||||
|
|
||||||
# cookie => 'lemonldapidp=http://auth.idp.com/saml/metadata'
|
# cookie => 'lemonldapidp=http://auth.idp.com/saml/metadata'
|
||||||
),
|
),
|
||||||
"Push request to OP, endpoint $url"
|
"Push request to OP, endpoint $url"
|
||||||
);
|
);
|
||||||
|
@ -129,7 +129,7 @@ SKIP: {
|
||||||
ok(
|
ok(
|
||||||
$res = $sp->_get(
|
$res = $sp->_get(
|
||||||
"/",
|
"/",
|
||||||
query => "idp=".uri_escape("http://auth.idp.com/saml/metadata"),
|
query => "idp=" . uri_escape("http://auth.idp.com/saml/metadata"),
|
||||||
accept => 'text/html',
|
accept => 'text/html',
|
||||||
cookie => $spPdata,
|
cookie => $spPdata,
|
||||||
),
|
),
|
||||||
|
@ -138,9 +138,6 @@ SKIP: {
|
||||||
|
|
||||||
$spPdata = 'lemonldappdata=' . expectCookie( $res, 'lemonldappdata' );
|
$spPdata = 'lemonldappdata=' . expectCookie( $res, 'lemonldappdata' );
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
my ( $host, $tmp );
|
my ( $host, $tmp );
|
||||||
( $url, $query ) = expectRedirection( $res,
|
( $url, $query ) = expectRedirection( $res,
|
||||||
qr#^http://auth.idp.com(/saml/singleSignOn)\?(SAMLRequest=.+)# );
|
qr#^http://auth.idp.com(/saml/singleSignOn)\?(SAMLRequest=.+)# );
|
||||||
|
@ -433,10 +430,10 @@ sub sp {
|
||||||
userDB => 'Same',
|
userDB => 'Same',
|
||||||
issuerDBSAMLActivation => 0,
|
issuerDBSAMLActivation => 0,
|
||||||
issuerDBOpenIDConnectActivation => 1,
|
issuerDBOpenIDConnectActivation => 1,
|
||||||
samlDiscoveryProtocolURL => 'http://discovery.example.com/',
|
samlDiscoveryProtocolURL => 'http://discovery.example.com/',
|
||||||
samlDiscoveryProtocolActivation => 1,
|
samlDiscoveryProtocolActivation => 1,
|
||||||
|
|
||||||
oidcRPMetaDataExportedVars => {
|
oidcRPMetaDataExportedVars => {
|
||||||
rp => {
|
rp => {
|
||||||
email => "mail",
|
email => "mail",
|
||||||
family_name => "cn",
|
family_name => "cn",
|
||||||
|
|
|
@ -25,7 +25,8 @@ SKIP: {
|
||||||
portalDisplayRegister => 1,
|
portalDisplayRegister => 1,
|
||||||
registerDB => 'Demo',
|
registerDB => 'Demo',
|
||||||
captcha_register_enabled => 0,
|
captcha_register_enabled => 0,
|
||||||
requireToken => '!$env->{ipAddr} || $env->{ipAddr} ne "127.1.1.1"',
|
requireToken =>
|
||||||
|
'!$env->{ipAddr} || $env->{ipAddr} ne "127.1.1.1"',
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|
|
@ -27,7 +27,7 @@ SKIP: {
|
||||||
userDB => 'Same',
|
userDB => 'Same',
|
||||||
registerDB => 'Demo',
|
registerDB => 'Demo',
|
||||||
captcha_register_enabled => 0,
|
captcha_register_enabled => 0,
|
||||||
tokenUseGlobalStorage => 1,
|
tokenUseGlobalStorage => 1,
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|
|
@ -24,14 +24,14 @@ SKIP: {
|
||||||
|
|
||||||
my $client = LLNG::Manager::Test->new( {
|
my $client = LLNG::Manager::Test->new( {
|
||||||
ini => {
|
ini => {
|
||||||
logLevel => 'error',
|
logLevel => 'error',
|
||||||
useSafeJail => 1,
|
useSafeJail => 1,
|
||||||
portalDisplayRegister => 1,
|
portalDisplayRegister => 1,
|
||||||
authentication => 'Demo',
|
authentication => 'Demo',
|
||||||
userDB => 'Same',
|
userDB => 'Same',
|
||||||
passwordDB => 'Demo',
|
passwordDB => 'Demo',
|
||||||
captcha_mail_enabled => 0,
|
captcha_mail_enabled => 0,
|
||||||
requireToken => '$env->{ipAddr} !~ /127\.0\.[1-3]\.1/',
|
requireToken => '$env->{ipAddr} !~ /127\.0\.[1-3]\.1/',
|
||||||
portalDisplayResetPassword => 1,
|
portalDisplayResetPassword => 1,
|
||||||
portalMainLogo => 'common/logos/logo_llng_old.png',
|
portalMainLogo => 'common/logos/logo_llng_old.png',
|
||||||
}
|
}
|
||||||
|
|
|
@ -95,8 +95,7 @@ count(1);
|
||||||
ok( $res->[2]->[0] =~ m%<td class="text-left">_user</td>%,
|
ok( $res->[2]->[0] =~ m%<td class="text-left">_user</td>%,
|
||||||
'Found attribute _user' )
|
'Found attribute _user' )
|
||||||
or explain( $res->[2]->[0], 'Attribute _user' );
|
or explain( $res->[2]->[0], 'Attribute _user' );
|
||||||
ok( $res->[2]->[0] =~ m%<td class="text-left">dwho</td>%,
|
ok( $res->[2]->[0] =~ m%<td class="text-left">dwho</td>%, 'Found value dwho' )
|
||||||
'Found value dwho' )
|
|
||||||
or explain( $res->[2]->[0], 'Value dwho' );
|
or explain( $res->[2]->[0], 'Value dwho' );
|
||||||
count(2);
|
count(2);
|
||||||
|
|
||||||
|
@ -123,7 +122,7 @@ count(1);
|
||||||
|
|
||||||
# Request with good VH & user
|
# Request with good VH & user
|
||||||
$query =~
|
$query =~
|
||||||
s#url=http%3A%2F%2Ftry.example.com#url=hTTp%3A%2F%2FTest1.exAmple.cOm/UriTesT#;
|
s#url=http%3A%2F%2Ftry.example.com#url=hTTp%3A%2F%2FTest1.exAmple.cOm/UriTesT#;
|
||||||
|
|
||||||
ok(
|
ok(
|
||||||
$res = $client->_post(
|
$res = $client->_post(
|
||||||
|
@ -141,7 +140,8 @@ count(1);
|
||||||
expectForm( $res, undef, '/checkuser', 'user', 'url' );
|
expectForm( $res, undef, '/checkuser', 'user', 'url' );
|
||||||
ok( $res->[2]->[0] =~ m%<span trspan="checkUser">%, 'Found trspan="checkUser"' )
|
ok( $res->[2]->[0] =~ m%<span trspan="checkUser">%, 'Found trspan="checkUser"' )
|
||||||
or explain( $res->[2]->[0], 'trspan="checkUser"' );
|
or explain( $res->[2]->[0], 'trspan="checkUser"' );
|
||||||
ok( $res->[2]->[0] =~ m%value="http://test1.example.com/UriTesT"%, 'Found well formatted url' )
|
ok( $res->[2]->[0] =~ m%value="http://test1.example.com/UriTesT"%,
|
||||||
|
'Found well formatted url' )
|
||||||
or explain( $res->[2]->[0], 'Well formatted url' );
|
or explain( $res->[2]->[0], 'Well formatted url' );
|
||||||
count(2);
|
count(2);
|
||||||
|
|
||||||
|
@ -196,7 +196,8 @@ count(1);
|
||||||
expectForm( $res, undef, '/checkuser', 'user', 'url' );
|
expectForm( $res, undef, '/checkuser', 'user', 'url' );
|
||||||
ok( $res->[2]->[0] =~ m%<span trspan="checkUser">%, 'Found trspan="checkUser"' )
|
ok( $res->[2]->[0] =~ m%<span trspan="checkUser">%, 'Found trspan="checkUser"' )
|
||||||
or explain( $res->[2]->[0], 'trspan="checkUser"' );
|
or explain( $res->[2]->[0], 'trspan="checkUser"' );
|
||||||
ok( $res->[2]->[0] =~ m%value="http://test1.example.com:1234"%, 'Found well formatted url' )
|
ok( $res->[2]->[0] =~ m%value="http://test1.example.com:1234"%,
|
||||||
|
'Found well formatted url' )
|
||||||
or explain( $res->[2]->[0], 'Well formatted url' );
|
or explain( $res->[2]->[0], 'Well formatted url' );
|
||||||
count(2);
|
count(2);
|
||||||
|
|
||||||
|
|
|
@ -269,7 +269,8 @@ ok( $res->[2]->[0] =~ m%<td class="text-left">testPrefix_groups</td>%,
|
||||||
or explain( $res->[2]->[0], 'testPrefix_groups' );
|
or explain( $res->[2]->[0], 'testPrefix_groups' );
|
||||||
ok( $res->[2]->[0] =~ m%<td class="text-left">su</td>%, 'Found su' )
|
ok( $res->[2]->[0] =~ m%<td class="text-left">su</td>%, 'Found su' )
|
||||||
or explain( $res->[2]->[0], 'su' );
|
or explain( $res->[2]->[0], 'su' );
|
||||||
ok( $res->[2]->[0] =~ m%<td class="text-left">testPrefix_uid</td>%, 'Found testPrefix_uid' )
|
ok( $res->[2]->[0] =~ m%<td class="text-left">testPrefix_uid</td>%,
|
||||||
|
'Found testPrefix_uid' )
|
||||||
or explain( $res->[2]->[0], 'testPrefix_groups' );
|
or explain( $res->[2]->[0], 'testPrefix_groups' );
|
||||||
ok( $res->[2]->[0] =~ m%<td class="text-left">rtyler</td>%, 'Found rtyler' )
|
ok( $res->[2]->[0] =~ m%<td class="text-left">rtyler</td>%, 'Found rtyler' )
|
||||||
or explain( $res->[2]->[0], 'su' );
|
or explain( $res->[2]->[0], 'su' );
|
||||||
|
|
|
@ -269,11 +269,12 @@ JjTJecOOS+88fK8qL1TrYv5rapIdqUI7aQ==
|
||||||
or print STDERR Dumper($res);
|
or print STDERR Dumper($res);
|
||||||
|
|
||||||
# Two 2F devices must be registered
|
# Two 2F devices must be registered
|
||||||
my @sf = map m%<span device=\'(TOTP|U2F)\' epoch=\'\d{10}\'%g, $res->[2]->[0];
|
my @sf = map m%<span device=\'(TOTP|U2F)\' epoch=\'\d{10}\'%g,
|
||||||
|
$res->[2]->[0];
|
||||||
ok( scalar @sf == 2, 'Two 2F devices found' )
|
ok( scalar @sf == 2, 'Two 2F devices found' )
|
||||||
or print STDERR Dumper($res);
|
or print STDERR Dumper($res);
|
||||||
ok( $sf[0] eq 'TOTP', 'TOTP device found' ) or print STDERR Dumper( \@sf );
|
ok( $sf[0] eq 'TOTP', 'TOTP device found' ) or print STDERR Dumper( \@sf );
|
||||||
ok( $sf[1] eq 'U2F', 'U2F device found' ) or print STDERR Dumper( \@sf );
|
ok( $sf[1] eq 'U2F', 'U2F device found' ) or print STDERR Dumper( \@sf );
|
||||||
|
|
||||||
# Unregister TOTP
|
# Unregister TOTP
|
||||||
ok( $res->[2]->[0] =~ qr%TOTP.*epoch.*(\d{10})%m, "TOTP epoch $1 found" )
|
ok( $res->[2]->[0] =~ qr%TOTP.*epoch.*(\d{10})%m, "TOTP epoch $1 found" )
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
use IO::Pipe;
|
use IO::Pipe;
|
||||||
use IO::Select;
|
use IO::Select;
|
||||||
our ( $in, $out ) = ( IO::Pipe->new, IO::Pipe->new );
|
our ( $in, $out ) = ( IO::Pipe->new, IO::Pipe->new );
|
||||||
our ( $rin, $rout ) = ( IO::Pipe->new, IO::Pipe->new );
|
our ( $rin, $rout ) = ( IO::Pipe->new, IO::Pipe->new );
|
||||||
my $pid = fork;
|
my $pid = fork;
|
||||||
|
|
||||||
|
@ -38,20 +38,21 @@ $s->add($rin);
|
||||||
sub handler {
|
sub handler {
|
||||||
my (%args) = @_;
|
my (%args) = @_;
|
||||||
print $in JSON::to_json( $args{req} ) . "\n";
|
print $in JSON::to_json( $args{req} ) . "\n";
|
||||||
while(my @ready = $s->can_read) {
|
while ( my @ready = $s->can_read ) {
|
||||||
foreach $fh (@ready) {
|
foreach $fh (@ready) {
|
||||||
if($fh == $out) {
|
if ( $fh == $out ) {
|
||||||
my $res = <$out>;
|
my $res = <$out>;
|
||||||
return JSON::from_json($res);
|
return JSON::from_json($res);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
my $res = <$rin>;
|
my $res = <$rin>;
|
||||||
$res = $args{sub}->(JSON::from_json($res));
|
$res = $args{sub}->( JSON::from_json($res) );
|
||||||
print $rout JSON::to_json($res)."\n";
|
print $rout JSON::to_json($res) . "\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
sub end_handler {
|
sub end_handler {
|
||||||
print $in "END\n";
|
print $in "END\n";
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user