Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
lemonldap-ng
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Maxime Besson
lemonldap-ng
Commits
09b4d1a5
Commit
09b4d1a5
authored
Dec 23, 2016
by
Yadd
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Clean tests (not finished) (#595)'
parent
3d23dc27
Changes
12
Hide whitespace changes
Inline
Side-by-side
Showing
12 changed files
with
161 additions
and
169 deletions
+161
-169
lemonldap-ng-portal/t/01-AuthDemo.t
lemonldap-ng-portal/t/01-AuthDemo.t
+13
-27
lemonldap-ng-portal/t/02-Password-Demo.t
lemonldap-ng-portal/t/02-Password-Demo.t
+9
-12
lemonldap-ng-portal/t/03-XSS-protection.t
lemonldap-ng-portal/t/03-XSS-protection.t
+6
-10
lemonldap-ng-portal/t/04-Notification-File.t
lemonldap-ng-portal/t/04-Notification-File.t
+8
-13
lemonldap-ng-portal/t/20-Auth-and-password-DBI.t
lemonldap-ng-portal/t/20-Auth-and-password-DBI.t
+8
-12
lemonldap-ng-portal/t/21-Auth-and-password-LDAP.t
lemonldap-ng-portal/t/21-Auth-and-password-LDAP.t
+4
-7
lemonldap-ng-portal/t/22-Auth-and-password-AD.t
lemonldap-ng-portal/t/22-Auth-and-password-AD.t
+5
-7
lemonldap-ng-portal/t/23-AuthNull.t
lemonldap-ng-portal/t/23-AuthNull.t
+3
-6
lemonldap-ng-portal/t/24-AuthApache.t
lemonldap-ng-portal/t/24-AuthApache.t
+2
-5
lemonldap-ng-portal/t/25-AuthSlave.t
lemonldap-ng-portal/t/25-AuthSlave.t
+3
-6
lemonldap-ng-portal/t/26-AuthRemote.t
lemonldap-ng-portal/t/26-AuthRemote.t
+6
-24
lemonldap-ng-portal/t/test-lib.pm
lemonldap-ng-portal/t/test-lib.pm
+94
-40
No files found.
lemonldap-ng-portal/t/01-AuthDemo.t
View file @
09b4d1a5
...
...
@@ -12,8 +12,8 @@ my $client = LLNG::Manager::Test->new(
# Test normal first access
# ------------------------
ok
(
$res
=
$client
->
_get
('
/
'),
'
Unauth JSON request
'
);
ok
(
$res
->
[
0
]
==
401
,
'
Response is 401
'
)
or
explain
(
$res
,
401
);
count
(
2
);
count
(
1
);
expectReject
(
$res
);
# Test "first access" with good url
ok
(
...
...
@@ -21,8 +21,8 @@ ok(
$client
->
_get
(
'
/
',
query
=>
'
url=aHR0cDovL3Rlc3QxLmV4YW1wbGUuY29tLw==
'
),
'
Unauth ajax request with good url
'
);
ok
(
$res
->
[
0
]
==
401
,
'
Response is 401
'
)
or
explain
(
$res
,
401
);
count
(
2
);
count
(
1
);
expectReject
(
$res
);
# Try to authenticate
# -------------------
...
...
@@ -34,12 +34,9 @@ ok(
),
'
Auth query
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
my
$cookies
=
$client
->
getCookies
(
$res
);
my
$id
;
ok
(
$id
=
$cookies
->
{
lemonldap
},
'
Get cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
count
(
3
);
count
(
1
);
expectOK
(
$res
);
my
$id
=
expectCookie
(
$res
);
# Try to get a redirection for an auth user with a valid url
# ----------------------------------------------------------
...
...
@@ -52,16 +49,9 @@ ok(
),
'
Auth ajax request with good url
'
);
ok
(
$res
->
[
0
]
==
302
,
'
Get redirection
'
)
or
explain
(
[
$res
->
[
0
],
$res
->
[
1
]
],
302
);
my
%hdrs
=
@
{
$res
->
[
1
]
};
ok
(
$hdrs
{
Location
}
eq
'
http://test1.example.com/
',
'
Location is http://test1.example.com/
'
)
or
explain
(
\
%hdrs
,
'
Location => "http://test1.example.com/"
'
);
ok
(
$hdrs
{'
Lm-Remote-User
'}
eq
'
dwho
',
'
User is set
'
)
or
explain
(
\
%hdrs
,
'
Lm-Remote-User => "dwho"
'
);
count
(
4
);
count
(
1
);
expectRedirection
(
$res
,
'
http://test1.example.com/
'
);
expectAuthenticatedAs
(
$res
,
'
dwho
'
);
# Try to get a redirection for an auth user with a bad url (host undeclared
# in manager)
...
...
@@ -75,13 +65,9 @@ ok(
),
'
Auth request with bad url
'
);
ok
(
$res
->
[
0
]
==
200
,
'
HTTP code is 200
'
)
or
explain
(
$res
,
200
);
%hdrs
=
@
{
$res
->
[
1
]
};
ok
(
$hdrs
{'
Lm-Remote-User
'}
eq
'
dwho
',
'
User is set
'
)
or
explain
(
\
%hdrs
,
'
Lm-Remote-User => "dwho"
'
);
ok
(
$hdrs
{'
Content-Type
'}
eq
'
text/html
',
'
Reponse is HTML
'
)
or
explain
(
\
%hdrs
,
'
Content-Type => "text/html"
'
);
count
(
4
);
count
(
1
);
expectOK
(
$res
);
expectAuthenticatedAs
(
$res
,
'
dwho
'
);
# Test logout
$client
->
logout
(
$id
);
...
...
lemonldap-ng-portal/t/02-Password-Demo.t
View file @
09b4d1a5
...
...
@@ -29,12 +29,9 @@ ok(
),
'
Auth query
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
my
$cookies
=
$client
->
getCookies
(
$res
);
my
$id
;
ok
(
$id
=
$cookies
->
{
lemonldap
},
'
Get cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
count
(
3
);
count
(
1
);
expectOK
(
$res
);
my
$id
=
expectCookie
(
$res
);
# Test mismatch pwd
ok
(
...
...
@@ -47,13 +44,13 @@ ok(
),
'
Password mismatch
'
);
ok
(
$res
->
[
0
]
==
400
,
'
Response is 400
'
)
or
explain
(
$res
->
[
0
],
400
);
expectBadRequest
(
$res
);
my
$json
;
ok
(
$json
=
eval
{
from_json
(
$res
->
[
2
]
->
[
0
]
)
},
'
Response is JSON
'
)
or
print
STDERR
"
$@
\n
"
.
Dumper
(
$res
);
ok
(
$json
->
{
error
}
==
PE_PASSWORD_MISMATCH
,
'
Response is PE_PASSWORD_MISMATCH
'
)
or
explain
(
$json
,
"
error => 34
"
);
count
(
4
);
count
(
3
);
# Test missing old pwd
ok
(
...
...
@@ -66,14 +63,14 @@ ok(
),
'
Missing old password
'
);
ok
(
$res
->
[
0
]
==
400
,
'
Response is 400
'
)
or
explain
(
$res
->
[
0
],
400
);
expectBadRequest
(
$res
);
ok
(
$json
=
eval
{
from_json
(
$res
->
[
2
]
->
[
0
]
)
},
'
Response is JSON
'
)
or
print
STDERR
"
$@
\n
"
.
Dumper
(
$res
);
ok
(
$json
->
{
error
}
==
PE_PP_MUST_SUPPLY_OLD_PASSWORD
,
'
Response is PE_PP_MUST_SUPPLY_OLD_PASSWORD
'
)
or
explain
(
$json
,
"
error => 27
"
);
count
(
4
);
count
(
3
);
# Test bad old pwd
ok
(
...
...
@@ -86,12 +83,12 @@ ok(
),
'
Bad old password
'
);
ok
(
$res
->
[
0
]
==
400
,
'
Response is 400
'
)
or
explain
(
$res
->
[
0
],
400
);
expectBadRequest
(
$res
);
ok
(
$json
=
eval
{
from_json
(
$res
->
[
2
]
->
[
0
]
)
},
'
Response is JSON
'
)
or
print
STDERR
"
$@
\n
"
.
Dumper
(
$res
);
ok
(
$json
->
{
error
}
==
PE_BADOLDPASSWORD
,
'
Response is PE_BADOLDPASSWORD
'
)
or
explain
(
$json
,
"
error => 27
"
);
count
(
4
);
count
(
3
);
# Test $client->logout
$client
->
logout
(
$id
);
...
...
lemonldap-ng-portal/t/03-XSS-protection.t
View file @
09b4d1a5
...
...
@@ -109,12 +109,9 @@ ok(
),
'
Auth query
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
my
$id
;
ok
(
$id
=
$client
->
getCookies
(
$res
)
->
{
lemonldap
},
'
Get LLNG cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
count
(
3
);
count
(
1
);
expectOK
(
$res
);
my
$id
=
expectCookie
(
$res
);
while
(
defined
(
my
$url
=
shift
(
@tests
)
)
)
{
last
if
(
$url
eq
'
LOGOUT
'
);
...
...
@@ -162,10 +159,9 @@ while ( defined( my $url = shift(@tests) ) ) {
),
'
Auth query
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
ok
(
$id
=
$client
->
getCookies
(
$res
)
->
{
lemonldap
},
'
Get LLNG cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
count
(
5
);
expectOK
(
$res
);
$id
=
expectCookie
(
$res
);
count
(
3
);
}
clean_sessions
();
...
...
lemonldap-ng-portal/t/04-Notification-File.t
View file @
09b4d1a5
...
...
@@ -44,12 +44,9 @@ ok(
),
'
Auth query
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
my
$cookies
=
$client
->
getCookies
(
$res
);
my
$id
;
ok
(
$id
=
$cookies
->
{
lemonldap
},
'
Get cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
count
(
3
);
count
(
1
);
expectOK
(
$res
);
my
$id
=
expectCookie
(
$res
);
# Verify that cookie is ciphered (session unvalid)
ok
(
...
...
@@ -60,9 +57,8 @@ ok(
),
'
Test cookie received
'
);
ok
(
$res
->
[
0
]
==
401
,
"
Session isn't valid
"
)
or
explain
(
[
$res
->
[
0
],
$res
->
[
1
]
],
401
);
count
(
2
);
count
(
1
);
expectReject
(
$res
);
# Try to validate notification without accepting it
my
$str
=
'
reference1x1=testref&url=aHR0cDovL3Rlc3QxLmV4YW1wbGUuY29tLw==
';
...
...
@@ -81,7 +77,7 @@ ok( $res->[0] == 200, "Don't receive redirection" )
count
(
2
);
# Try to validate notification
my
$str
=
$str
=
'
reference1x1=testref&check1x1x1=accepted&url=aHR0cDovL3Rlc3QxLmV4YW1wbGUuY29tLw==
';
ok
(
$res
=
$client
->
_post
(
...
...
@@ -93,11 +89,10 @@ ok(
),
"
Accept notification
"
);
ok
(
$res
->
[
0
]
==
302
,
"
Get redirection
"
)
or
explain
(
[
$res
->
[
0
],
$res
->
[
1
]
],
302
);
expectRedirection
(
$res
,
qr/./
);
$file
=~
s/xml$/done/
;
ok
(
-
e
$file
,
'
Notification was deleted
'
);
count
(
3
);
count
(
2
);
#print STDERR Dumper($res);
...
...
lemonldap-ng-portal/t/20-Auth-and-password-DBI.t
View file @
09b4d1a5
...
...
@@ -5,13 +5,14 @@ use IO::String;
require
'
t/test-lib.pm
';
my
$res
;
my
$mainTests
=
3
;
eval
{
unlink
'
t/userdb.db
'
};
SKIP:
{
eval
{
require
DBI
;
require
DBD::
SQLite
;
};
if
(
$@
)
{
skip
'
DBD::SQLite not found
',
8
;
skip
'
DBD::SQLite not found
',
$mainTests
;
}
my
$dbh
=
DBI
->
connect
("
dbi:SQLite:dbname=t/userdb.db
");
$dbh
->
do
('
CREATE TABLE users (user text,password text,name text)
');
...
...
@@ -46,11 +47,8 @@ SKIP: {
),
'
Auth query
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
my
$cookies
=
$client
->
getCookies
(
$res
);
my
$id
;
ok
(
$id
=
$cookies
->
{
lemonldap
},
'
Get cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
expectOK
(
$res
);
my
$id
=
expectCookie
(
$res
);
ok
(
$res
=
$client
->
_post
(
...
...
@@ -63,7 +61,7 @@ SKIP: {
),
'
Change password
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
,
200
);
expectOK
(
$res
);
$client
->
logout
(
$id
);
ok
(
$res
=
$client
->
_post
(
...
...
@@ -74,14 +72,12 @@ SKIP: {
),
'
Auth query with new password
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
$cookies
=
$client
->
getCookies
(
$res
);
ok
(
$id
=
$cookies
->
{
lemonldap
},
'
Get cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
expectOK
(
$res
);
$id
=
expectCookie
(
$res
);
$client
->
logout
(
$id
);
clean_sessions
();
}
eval
{
unlink
'
t/userdb.db
'
};
count
(
8
);
count
(
$mainTests
);
done_testing
(
count
()
);
lemonldap-ng-portal/t/21-Auth-and-password-LDAP.t
View file @
09b4d1a5
...
...
@@ -7,7 +7,7 @@ require 't/test-lib.pm';
my
$res
;
SKIP:
{
skip
'
No LDAP server given
',
3
unless
(
$ENV
{
LDAPSERVER
}
);
skip
'
No LDAP server given
',
1
unless
(
$ENV
{
LDAPSERVER
}
);
my
$client
=
LLNG::Manager::
Test
->
new
(
{
...
...
@@ -38,14 +38,11 @@ SKIP: {
),
'
Auth query
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
my
$cookies
=
$client
->
getCookies
(
$res
);
my
$id
;
ok
(
$id
=
$cookies
->
{
lemonldap
},
'
Get cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
expectOK
(
$res
);
my
$id
=
expectCookie
(
$res
);
$client
->
logout
(
$id
);
clean_sessions
();
}
count
(
3
);
count
(
1
);
done_testing
(
count
()
);
lemonldap-ng-portal/t/22-Auth-and-password-AD.t
View file @
09b4d1a5
...
...
@@ -5,9 +5,10 @@ use IO::String;
require
'
t/test-lib.pm
';
my
$res
;
my
$mainTests
=
1
;
SKIP:
{
skip
'
No AD server given
',
3
unless
(
$ENV
{
ADSERVER
}
);
skip
'
No AD server given
',
$mainTests
unless
(
$ENV
{
ADSERVER
}
);
my
$client
=
LLNG::Manager::
Test
->
new
(
{
...
...
@@ -38,14 +39,11 @@ SKIP: {
),
'
Auth query
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
my
$cookies
=
$client
->
getCookies
(
$res
);
my
$id
;
ok
(
$id
=
$cookies
->
{
lemonldap
},
'
Get cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
expectOK
(
$res
);
my
$id
=
expectCookie
(
$res
);
$client
->
logout
(
$id
);
clean_sessions
();
}
count
(
3
);
count
(
$mainTests
);
done_testing
(
count
()
);
lemonldap-ng-portal/t/23-AuthNull.t
View file @
09b4d1a5
...
...
@@ -17,12 +17,9 @@ my $client = LLNG::Manager::Test->new(
);
ok
(
$res
=
$client
->
_get
('
/
'),
'
Auth query
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
my
$cookies
=
$client
->
getCookies
(
$res
);
my
$id
;
ok
(
$id
=
$cookies
->
{
lemonldap
},
'
Get cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
count
(
1
);
expectOK
(
$res
);
my
$id
=
expectCookie
(
$res
);
clean_sessions
();
count
(
3
);
done_testing
(
count
()
);
lemonldap-ng-portal/t/24-AuthApache.t
View file @
09b4d1a5
...
...
@@ -17,11 +17,8 @@ my $client = LLNG::Manager::Test->new(
);
ok
(
$res
=
$client
->
_get
(
'
/
',
remote_user
=>
'
dwho
'
),
'
Auth query
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
my
$cookies
=
$client
->
getCookies
(
$res
);
my
$id
;
ok
(
$id
=
$cookies
->
{
lemonldap
},
'
Get cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
expectOK
(
$res
);
my
$id
=
expectCookie
(
$res
);
clean_sessions
();
count
(
3
);
...
...
lemonldap-ng-portal/t/25-AuthSlave.t
View file @
09b4d1a5
...
...
@@ -26,12 +26,9 @@ ok(
),
'
Auth query
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
my
$cookies
=
$client
->
getCookies
(
$res
);
my
$id
;
ok
(
$id
=
$cookies
->
{
lemonldap
},
'
Get cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
count
(
1
);
expectOK
(
$res
);
my
$id
=
expectCookie
(
$res
);
clean_sessions
();
count
(
3
);
done_testing
(
count
()
);
lemonldap-ng-portal/t/26-AuthRemote.t
View file @
09b4d1a5
...
...
@@ -25,24 +25,8 @@ my $client = LLNG::Manager::Test->new(
# Test redirection to remote portal
ok
(
$res
=
$client
->
_get
(
'
/
',
accept
=>
'
text/html
'
),
'
First request
'
);
ok
(
$res
->
[
0
]
==
302
,
'
Response is 302
'
)
or
explain
(
$res
->
[
0
],
302
);
my
@tmp
=
@
{
$res
->
[
1
]
};
while
(
@tmp
and
$tmp
[
0
]
ne
'
Location
'
)
{
shift
@tmp
;
}
ok
(
(
$tmp
[
0
]
and
$tmp
[
1
]
eq
'
http://auth2.example.com?url=aHR0cDovL2F1dGguZXhhbXBsZS5jb20v
'
),
'
Get redirection to remote portal
'
)
or
explain
(
$res
->
[
1
],
'
Location => http://auth2.example.com?url=aHR0cDovL2F1dGguZXhhbXBsZS5jb20v
'
);
count
(
3
);
count
(
1
);
expectRedirection
(
$res
,
'
http://auth2.example.com?url=aHR0cDovL2F1dGguZXhhbXBsZS5jb20v
');
ok
(
$res
=
$client
->
_get
(
...
...
@@ -52,12 +36,10 @@ ok(
),
'
Auth query
'
);
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
my
$cookies
=
$client
->
getCookies
(
$res
);
my
$id
;
ok
(
$id
=
$cookies
->
{
lemonldap
},
'
Get cookie
'
)
or
explain
(
$res
,
'
Set-Cookie: something
'
);
count
(
3
);
count
(
1
);
expectOK
(
$res
);
my
$id
=
expectCookie
(
$res
);
clean_sessions
();
done_testing
(
count
()
);
lemonldap-ng-portal/t/test-lib.pm
View file @
09b4d1a5
...
...
@@ -43,6 +43,98 @@ sub clean_sessions {
}
}
sub
expectRedirection
{
my
(
$res
,
$location
)
=
@_
;
ok
(
$res
->
[
0
]
==
302
,
'
Get redirection
'
)
or
explain
(
$res
->
[
0
],
302
);
count
(
2
);
if
(
ref
$location
)
{
my
@match
;
@match
=
(
getRedirection
(
$res
)
=~
$location
);
ok
(
@match
,
'
Location header found
'
)
or
explain
(
$res
->
[
1
],
"
Location match:
"
.
Dumper
(
$location
)
);
return
@match
;
}
else
{
ok
(
getRedirection
(
$res
)
eq
$location
,
"
Location is
$location
"
)
or
explain
(
$res
->
[
1
],
"
Location =>
$location
"
);
}
}
sub
expectAuthenticatedAs
{
my
(
$res
,
$user
)
=
@_
;
ok
(
getHeader
(
$res
,
'
Lm-Remote-User
'
)
eq
$user
,
"
Authenticated as
$user
"
)
or
explain
(
$res
->
[
1
],
"
Lm-Remote-User =>
$user
"
);
count
(
1
);
}
sub
expectOK
{
my
(
$res
)
=
@_
;
ok
(
$res
->
[
0
]
==
200
,
'
HTTP code is 200
'
)
or
explain
(
$res
,
200
);
count
(
1
);
}
sub
expectBadRequest
{
my
(
$res
)
=
@_
;
ok
(
$res
->
[
0
]
==
400
,
'
HTTP code is 400
'
)
or
explain
(
$res
->
[
0
],
400
);
count
(
1
);
}
sub
expectReject
{
my
(
$res
)
=
@_
;
ok
(
$res
->
[
0
]
==
401
,
'
Response is 401
'
)
or
explain
(
$res
->
[
0
],
401
);
count
(
1
);
}
sub
expectCookie
{
my
(
$res
,
$cookieName
)
=
@_
;
$cookieName
||=
'
lemonldap
';
my
$cookies
=
getCookies
(
$res
);
my
$id
;
ok
(
$id
=
$cookies
->
{
$cookieName
},
"
Get cookie
$cookieName
"
)
or
explain
(
$res
->
[
1
],
"
Set-Cookie:
$cookieName
=something
"
);
count
(
1
);
return
$id
;
}
sub
getCookies
{
my
(
$resp
)
=
@_
;
my
@hdrs
=
@
{
$resp
->
[
1
]
};
my
$res
=
{};
while
(
my
$name
=
shift
@hdrs
)
{
my
$v
=
shift
@hdrs
;
if
(
$name
eq
'
Set-Cookie
'
)
{
if
(
$v
=~
/^(\w+)=([^;]*)/
)
{
$res
->
{
$
1
}
=
$
2
;
}
}
}
return
$res
;
}
sub
getHeader
{
my
(
$resp
,
$hname
)
=
@_
;
my
@hdrs
=
@
{
$resp
->
[
1
]
};
my
$res
=
{};
while
(
my
$name
=
shift
@hdrs
)
{
my
$v
=
shift
@hdrs
;
if
(
$name
eq
$hname
)
{
return
$v
;
}
}
return
undef
;
}
sub
getRedirection
{
my
(
$resp
)
=
@_
;
return
getHeader
(
$resp
,
'
Location
'
);
}
sub
getUser
{
my
(
$resp
)
=
@_
;
return
getHeader
(
$resp
,
'
Lm-Remote-User
'
);
}
package
LLNG::Manager::
Test
;
use
strict
;
...
...
@@ -93,13 +185,13 @@ sub logout {
cookie
=>
"
lemonldap=
$id
",
accept
=>
'
text/html
'
),
'
Logout
'
'
Logout
request
'
);
main::
ok
(
$res
->
[
0
]
==
200
,
'
Response is 200
'
)
or
explain
(
$res
->
[
0
],
200
);
my
$c
;
main::
ok
(
(
defined
(
$c
=
$self
->
getCookies
(
$res
)
->
{
lemonldap
}
)
and
not
$c
),
(
defined
(
$c
=
main::
getCookies
(
$res
)
->
{
lemonldap
}
)
and
not
$c
),
'
Cookie is deleted
'
)
or
explain
(
$res
->
[
1
],
"
Set-Cookie => 'lemonldap='
"
);
main::
ok
(
$res
=
$self
->
_get
(
'
/
',
cookie
=>
"
lemonldap=
$id
"
),
...
...
@@ -110,44 +202,6 @@ sub logout {
}
sub
getCookies
{
my
(
$self
,
$resp
)
=
@_
;
my
@hdrs
=
@
{
$resp
->
[
1
]
};
my
$res
=
{};
while
(
my
$name
=
shift
@hdrs
)
{
my
$v
=
shift
@hdrs
;
if
(
$name
eq
'
Set-Cookie
'
)
{
if
(
$v
=~
/^(\w+)=([^;]*)/
)
{
$res
->
{
$
1
}
=
$
2
;
}
}
}
return
$res
;
}
sub
getHeader
{
my
(
$self
,
$resp
,
$hname
)
=
@_
;
my
@hdrs
=
@
{
$resp
->
[
1
]
};
my
$res
=
{};
while
(
my
$name
=
shift
@hdrs
)
{
my
$v
=
shift
@hdrs
;
if
(
$name
eq
$hname
)
{
return
$v
;
}
}
return
undef
;
}
sub
getRedirection
{
my
(
$self
,
$resp
)
=
@_
;
return
$self
->
getHeader
(
$resp
,
'
Location
'
);
}
sub
getUser
{
my
(
$self
,
$resp
)
=
@_
;
return
$self
->
getHeader
(
$resp
,
'
Lm-Remote-User
'
);
}
sub
_get
{
my
(
$self
,
$path
,
%args
)
=
@_
;
return
$self
->
app
->
(
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment