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
747cd860
Commit
747cd860
authored
Dec 21, 2016
by
Yadd
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
CAS in progress (#595)
parent
ffd9ca43
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
402 additions
and
69 deletions
+402
-69
lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Issuer/CAS.pm
lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Issuer/CAS.pm
+363
-3
lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Issuer/SAML.pm
lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Issuer/SAML.pm
+18
-18
lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Lib/CAS.pm
lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Lib/CAS.pm
+2
-17
lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Main/Issuer.pm
lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Main/Issuer.pm
+3
-0
lemonldap-ng-portal/t/31-Auth-and-issuer-CAS.t
lemonldap-ng-portal/t/31-Auth-and-issuer-CAS.t
+16
-31
No files found.
lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Issuer/CAS.pm
View file @
747cd860
...
...
@@ -2,6 +2,7 @@ package Lemonldap::NG::Portal::Issuer::CAS;
use
strict
;
use
Mouse
;
use
URI
;
use
Lemonldap::NG::Portal::Main::
Constants
qw(
PE_CAS_SERVICE_NOT_ALLOWED
PE_CONFIRM
...
...
@@ -21,7 +22,17 @@ sub init {
my
(
$self
)
=
@_
;
# Launch parents initialization subroutines, then launch IdP en SP lists
return
(
$self
->
Lemonldap::NG::Portal::Main::Issuer::
init
()
);
my
$res
=
$self
->
Lemonldap::NG::Portal::Main::Issuer::
init
();
$self
->
addUnauthRoute
(
(
$self
->
path
)
=>
{
serviceValidate
=>
'
serviceValidate
',
validate
=>
'
validate
',
proxyValidate
=>
'
proxyValidate
',
proxy
=>
'
proxy
'
},
['
GET
']
);
return
$res
;
}
# RUNNING METHODS
...
...
@@ -173,7 +184,7 @@ sub run {
$req
->
{
urldc
}
=
$service_url
;
$req
->
steps
(
[]
);
$req
->
steps
(
[]
);
return
PE_OK
;
}
...
...
@@ -190,7 +201,10 @@ sub run {
# Delete local session
unless
(
$self
->
_deleteSession
(
$self
->
getApacheSession
(
$session_id
,
1
)
)
)
$self
->
_deleteSession
(
$self
->
p
->
getApacheSession
(
$session_id
,
1
)
)
)
{
$self
->
lmLog
(
"
Fail to delete session
$session_id
",
'
error
'
);
}
...
...
@@ -282,6 +296,352 @@ sub logout {
return
PE_OK
;
}
# Direct request from SP to IdP
sub
validate
{
my
(
$self
,
$req
)
=
@_
;
$self
->
lmLog
(
'
URL
'
.
$req
->
uri
.
'
detected as an CAS VALIDATE URL
',
'
debug
'
);
# GET parameters
my
$service
=
$req
->
param
('
service
');
my
$ticket
=
$req
->
param
('
ticket
');
my
$renew
=
$req
->
param
('
renew
');
# Required parameters: service and ticket
unless
(
$service
and
$ticket
)
{
$self
->
lmLog
(
"
Service and Ticket parameters required
",
'
error
'
);
return
$self
->
returnCasValidateError
();
}
$self
->
lmLog
(
"
Get validate request with ticket
$ticket
for service
$service
",
'
debug
'
);
unless
(
$ticket
=~
s/^ST-//
)
{
$self
->
lmLog
(
"
Provided ticket is not a service ticket (ST)
",
'
error
'
);
return
$self
->
returnCasValidateError
();
}
my
$casServiceSession
=
$self
->
getCasSession
(
$ticket
);
unless
(
$casServiceSession
)
{
$self
->
lmLog
(
"
Service ticket session
$ticket
not found
",
'
error
'
);
return
$self
->
returnCasValidateError
();
}
$self
->
lmLog
(
"
Service ticket session
$ticket
found
",
'
debug
'
);
my
$service1_uri
=
URI
->
new
(
$service
);
my
$service2_uri
=
URI
->
new
(
$casServiceSession
->
data
->
{
service
}
);
# Check service
unless
(
$service1_uri
->
eq
(
$service2_uri
)
)
{
# Tolerate that relative URI are the same
if
(
$service1_uri
->
rel
(
$service2_uri
)
eq
"
./
"
or
$service2_uri
->
rel
(
$service1_uri
)
eq
"
./
"
)
{
$self
->
lmLog
(
"
Submitted service
$service1_uri
does not exactly match initial service
"
.
$service2_uri
.
'
but difference is tolerated.
',
'
warn
'
);
}
else
{
$self
->
lmLog
(
"
Submitted service
$service
does not match initial service
"
.
$casServiceSession
->
data
->
{
service
},
'
error
'
);
$self
->
deleteCasSession
(
$casServiceSession
);
return
$self
->
returnCasValidateError
();
}
}
else
{
$self
->
lmLog
(
"
Submitted service
$service
math initial servce
",
'
debug
'
);
}
# Check renew
if
(
$renew
eq
'
true
'
)
{
# We should check the ST was delivered with primary credentials
$self
->
lmLog
(
"
Renew flag detected
",
'
debug
'
);
unless
(
$casServiceSession
->
data
->
{
renew
}
)
{
$self
->
lmLog
(
"
Authentication renew requested, but not done in former authentication process
",
'
error
'
);
$self
->
deleteCasSession
(
$casServiceSession
);
return
$self
->
returnCasValidateError
();
}
}
# Open local session
my
$localSession
=
$self
->
p
->
getApacheSession
(
$casServiceSession
->
data
->
{
_cas_id
},
1
);
unless
(
$localSession
)
{
$self
->
lmLog
(
"
Local session
"
.
$casServiceSession
->
data
->
{
_cas_id
}
.
"
notfound
",
'
error
'
);
$self
->
deleteCasSession
(
$casServiceSession
);
return
$self
->
returnCasValidateError
();
}
# Get username
my
$username
=
$localSession
->
data
->
{
$self
->
{
casAttr
}
||
$self
->
{
whatToTrace
}
};
$self
->
lmLog
(
"
Get username
$username
",
'
debug
'
);
# Return success message
$self
->
deleteCasSession
(
$casServiceSession
);
return
$self
->
returnCasValidateSuccess
(
$username
);
}
sub
proxy
{
my
(
$self
,
$req
)
=
@_
;
}
sub
serviceValidate
{
my
(
$self
,
$req
)
=
@_
;
return
$self
->
_validate2
(
'
SERVICE
',
$req
);
}
sub
proxyValidate
{
my
(
$self
,
$req
)
=
@_
;
return
$self
->
_validate2
(
'
PROXY
',
$req
);
}
# INTERNAL METHODS
sub
_validate2
{
my
(
$self
,
$urlType
,
$req
)
=
@_
;
$self
->
lmLog
(
'
URL
'
.
$req
->
uri
.
'
detected as an CAS $urlType VALIDATE URL
',
'
debug
'
);
# GET parameters
my
$service
=
$req
->
param
('
service
');
my
$ticket
=
$req
->
param
('
ticket
');
my
$pgtUrl
=
$req
->
param
('
pgtUrl
');
my
$renew
=
$req
->
param
('
renew
');
# PGTIOU
my
$casProxyGrantingTicketIOU
;
# Required parameters: service and ticket
unless
(
$service
and
$ticket
)
{
$self
->
lmLog
(
"
Service and Ticket parameters required
",
'
error
'
);
return
$self
->
returnCasServiceValidateError
(
'
INVALID_REQUEST
',
'
Missing mandatory parameters (service, ticket)
'
);
}
$self
->
lmLog
(
"
Get
"
.
lc
(
$urlType
)
.
"
validate request with ticket
$ticket
for service
$service
",
'
debug
'
);
# Get CAS session corresponding to ticket
if
(
$urlType
eq
'
SERVICE
'
and
!
(
$ticket
=~
s/^ST-//
)
)
{
$self
->
lmLog
(
"
Provided ticket is not a service ticket (ST)
",
'
error
'
);
return
$self
->
returnCasServiceValidateError
(
'
INVALID_TICKET
',
'
Provided ticket is not a service ticket
'
);
}
elsif
(
$urlType
eq
'
PROXY
'
and
!
(
$ticket
=~
s/^(P|S)T-//
)
)
{
$self
->
lmLog
(
"
Provided ticket is not a service or proxy ticket ($1T)
",
'
error
'
);
return
$self
->
returnCasServiceValidateError
(
'
INVALID_TICKET
',
'
Provided ticket is not a service or proxy ticket
'
);
}
my
$casServiceSession
=
$self
->
getCasSession
(
$ticket
);
unless
(
$casServiceSession
)
{
$self
->
lmLog
(
"
$urlType
ticket session
$ticket
not found
",
'
error
'
);
return
$self
->
returnCasServiceValidateError
(
'
INVALID_TICKET
',
'
Ticket not found
'
);
}
$self
->
lmLog
(
"
$urlType
ticket session
$ticket
found
",
'
debug
'
);
my
$service1_uri
=
URI
->
new
(
$service
);
my
$service2_uri
=
URI
->
new
(
$casServiceSession
->
data
->
{
service
}
);
# Check service
unless
(
$service1_uri
->
eq
(
$service2_uri
)
)
{
# Tolerate that relative URI are the same
if
(
$service1_uri
->
rel
(
$service2_uri
)
eq
"
./
"
or
$service2_uri
->
rel
(
$service1_uri
)
eq
"
./
"
)
{
$self
->
lmLog
(
"
Submitted service
$service1_uri
does not exactly match initial service
"
.
$service2_uri
.
'
but difference is tolerated.
',
'
warn
'
);
}
else
{
$self
->
lmLog
(
"
Submitted service
$service
does not match initial service
"
.
$casServiceSession
->
data
->
{
service
},
'
error
'
);
$self
->
deleteCasSession
(
$casServiceSession
);
return
$self
->
returnCasServiceValidateError
(
'
INVALID_SERVICE
',
'
Submitted service does not match initial service
'
);
}
}
else
{
$self
->
lmLog
(
"
Submitted service
$service
match initial service
",
'
debug
'
);
}
# Check renew
if
(
$renew
eq
'
true
'
)
{
# We should check the ST was delivered with primary credentials
$self
->
lmLog
(
"
Renew flag detected
",
'
debug
'
);
unless
(
$casServiceSession
->
data
->
{
renew
}
)
{
$self
->
lmLog
(
"
Authentication renew requested, but not done in former authentication process
",
'
error
'
);
$self
->
deleteCasSession
(
$casServiceSession
);
return
$self
->
returnCasValidateError
();
}
}
# Proxies (for PROXY VALIDATE only)
my
$proxies
=
$casServiceSession
->
data
->
{
proxies
};
# Proxy granting ticket
if
(
$pgtUrl
)
{
# Create a proxy granting ticket
$self
->
lmLog
(
"
Create a CAS proxy granting ticket for service
$service
",
'
debug
'
);
my
$casProxyGrantingSession
=
$self
->
getCasSession
();
if
(
$casProxyGrantingSession
)
{
my
$PGinfos
;
# PGT session
$PGinfos
->
{
type
}
=
'
casProxyGranting
';
$PGinfos
->
{
service
}
=
$service
;
$PGinfos
->
{
_cas_id
}
=
$casServiceSession
->
data
->
{
_cas_id
};
$PGinfos
->
{
_utime
}
=
$casServiceSession
->
data
->
{
_utime
};
# Trace proxies
$PGinfos
->
{
proxies
}
=
(
$proxies
?
$proxies
.
$self
->
{
multiValuesSeparator
}
.
$pgtUrl
:
$pgtUrl
);
my
$casProxyGrantingSessionID
=
$casProxyGrantingSession
->
id
;
my
$casProxyGrantingTicket
=
"
PGT-
"
.
$casProxyGrantingSessionID
;
$casProxyGrantingSession
->
update
(
$PGinfos
);
$self
->
lmLog
(
"
CAS proxy granting session
$casProxyGrantingSessionID
created
",
'
debug
'
);
# Generate the proxy granting ticket IOU
my
$tmpCasSession
=
$self
->
getCasSession
();
if
(
$tmpCasSession
)
{
$casProxyGrantingTicketIOU
=
"
PGTIOU-
"
.
$tmpCasSession
->
id
;
$self
->
deleteCasSession
(
$tmpCasSession
);
$self
->
lmLog
(
"
Generate proxy granting ticket IOU
$casProxyGrantingTicketIOU
",
'
debug
'
);
# Request pgtUrl
if
(
$self
->
callPgtUrl
(
$pgtUrl
,
$casProxyGrantingTicketIOU
,
$casProxyGrantingTicket
)
)
{
$self
->
lmLog
(
"
Proxy granting URL
$pgtUrl
called with success
",
'
debug
'
);
}
else
{
$self
->
lmLog
(
"
Error calling proxy granting URL
$pgtUrl
",
'
warn
'
);
$casProxyGrantingTicketIOU
=
undef
;
}
}
}
else
{
$self
->
lmLog
(
"
Error in proxy granting ticket management, bypass it
",
'
warn
'
);
}
}
# Open local session
my
$localSession
=
$self
->
p
->
getApacheSession
(
$casServiceSession
->
data
->
{
_cas_id
},
1
);
unless
(
$localSession
)
{
$self
->
lmLog
(
"
Local session
"
.
$casServiceSession
->
data
->
{
_cas_id
}
.
"
notfound
",
'
error
'
);
$self
->
deleteCasSession
(
$casServiceSession
);
return
$self
->
returnCasServiceValidateError
(
'
INTERNAL_ERROR
',
'
No session associated to ticket
'
);
}
# Get username
my
$username
=
$localSession
->
data
->
{
$self
->
{
casAttr
}
||
$self
->
{
whatToTrace
}
};
$self
->
lmLog
(
"
Get username
$username
",
'
debug
'
);
# Get attributes [CAS 3.0]
my
$attributes
=
{};
if
(
defined
$self
->
{
casAttributes
}
)
{
foreach
my
$casAttribute
(
keys
%
{
$self
->
{
casAttributes
}
}
)
{
my
$localSessionValue
=
$localSession
->
data
->
{
$self
->
{
casAttributes
}
->
{
$casAttribute
}
};
$attributes
->
{
$casAttribute
}
=
$localSessionValue
if
defined
$localSessionValue
;
}
}
# Return success message
$self
->
deleteCasSession
(
$casServiceSession
);
return
$self
->
returnCasServiceValidateSuccess
(
$username
,
$casProxyGrantingTicketIOU
,
$proxies
,
$attributes
);
}
1
;
__END__
...
...
lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Issuer/SAML.pm
View file @
747cd860
...
...
@@ -50,23 +50,6 @@ sub init {
qr/^($saml_sso_soap_url|$saml_sso_soap_url_ret|$saml_sso_get_url|$saml_sso_get_url_ret|$saml_sso_post_url|$saml_sso_post_url_ret|$saml_sso_art_url|$saml_sso_art_url_ret)(?:\?.*)?$/
i
);
# SOAP routes (access without authentication)
$self
->
addRouteFromMetaDataURL
(
'
samlIDPSSODescriptorArtifactResolutionServiceArtifact
',
3
,
'
artifactServer
',
['
POST
']
);
$self
->
addRouteFromMetaDataURL
(
"
samlIDPSSODescriptorSingleLogoutServiceSOAP
",
1
,
'
soapSloServer
',
['
POST
']
);
$self
->
addRouteFromMetaDataURL
(
"
samlIDPSSODescriptorSingleLogoutServiceSOAP
",
2
,
'
soapSloServer
',
['
POST
']
);
# TODO: @coudot, why this URL isn't managed with a conf param ?
$self
->
addUnauthRoute
(
saml
=>
{
relaySingleLogoutSOAP
=>
'
sloRelaySoap
'
},
[
'
GET
',
'
POST
'
]
);
# Single logout routes (managed by regexp in run())
my
$saml_slo_get_url
=
$self
->
getMetaDataURL
(
"
samlIDPSSODescriptorSingleLogoutServiceHTTPRedirect
",
1
);
...
...
@@ -83,7 +66,7 @@ qr/^($saml_slo_get_url|$saml_slo_get_url_ret|$saml_slo_post_url|$saml_slo_post_u
);
# Launch parents initialization subroutines, then launch IdP en SP lists
return
(
my
$res
=
(
$self
->
Lemonldap::NG::Portal::Main::Issuer::
init
()
# Load SAML service
...
...
@@ -96,6 +79,23 @@ qr/^($saml_slo_get_url|$saml_slo_get_url_ret|$saml_slo_post_url|$saml_slo_post_u
# Required to manage SLO in Proxy mode
and
$self
->
loadIDPs
()
);
# SOAP routes (access without authentication)
$self
->
addRouteFromMetaDataURL
(
'
samlIDPSSODescriptorArtifactResolutionServiceArtifact
',
3
,
'
artifactServer
',
['
POST
']
);
$self
->
addRouteFromMetaDataURL
(
"
samlIDPSSODescriptorSingleLogoutServiceSOAP
",
1
,
'
soapSloServer
',
['
POST
']
);
$self
->
addRouteFromMetaDataURL
(
"
samlIDPSSODescriptorSingleLogoutServiceSOAP
",
2
,
'
soapSloServer
',
['
POST
']
);
# TODO: @coudot, why this URL isn't managed with a conf param ?
$self
->
addUnauthRoute
(
$self
->
path
=>
{
relaySingleLogoutSOAP
=>
'
sloRelaySoap
'
},
[
'
GET
',
'
POST
'
]
);
return
$res
;
}
# RUNNING METHODS
...
...
lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Lib/CAS.pm
View file @
747cd860
...
...
@@ -3,11 +3,6 @@ package Lemonldap::NG::Portal::Lib::CAS;
use
strict
;
use
Mouse
;
use
Lemonldap::NG::Portal::Main::
Constants
qw(
PE_OK
PE_SENDRESPONSE
)
;
our
$VERSION
=
'
2.0.0
';
# PROPERTIES
...
...
@@ -30,16 +25,7 @@ has ua => (
sub
sendSoapResponse
{
my
(
$self
,
$req
,
$s
)
=
@_
;
$req
->
response
(
[
200
,
[
'
Content-Length
'
=>
length
(
$s
)
],
[
$s
]
]
);
return
PE_SENDRESPONSE
;
return
[
200
,
[
'
Content-Length
'
=>
length
(
$s
)
],
[
$s
]
];
}
# Try to recover the CAS session corresponding to id and return session datas
...
...
@@ -78,8 +64,7 @@ sub returnCasValidateError {
$self
->
lmLog
(
"
Return CAS validate error
",
'
debug
'
);
$req
->
response
(
[
200
,
[
'
Content-Length
'
=>
4
],
["
no
\n\n
"]
]
);
return
PE_SENDRESPONSE
;
return
[
200
,
[
'
Content-Length
'
=>
4
],
["
no
\n\n
"]
];
}
# Return success for CAS VALIDATE request
...
...
lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Main/Issuer.pm
View file @
747cd860
...
...
@@ -19,6 +19,8 @@ our $VERSION = '2.0.0';
has
type
=>
(
is
=>
'
rw
'
);
has
path
=>
(
is
=>
'
rw
'
);
# INTERFACE
# Only logout is called in normal use. Issuer that inherits from this
...
...
@@ -34,6 +36,7 @@ sub init {
$self
->
type
(
$type
);
if
(
my
$path
=
$self
->
conf
->
{"
issuerDB
${type}
Path
"}
)
{
$path
=~
s/^.*?(\w+).*?$/$1/
;
$self
->
path
(
$path
);
$self
->
addUnauthRoute
(
$path
=>
{
'
*
'
=>
'
_redirect
'
},
['
GET
']
);
$self
->
addUnauthRoute
(
$path
=>
{
'
*
'
=>
'
_pRedirect
'
},
['
POST
']
);
$self
->
addAuthRoute
(
$path
=>
{
'
*
'
=>
"
_forAuthUser
"
},
['
GET
']
);
...
...
lemonldap-ng-portal/t/31-Auth-and-issuer-CAS.t
View file @
747cd860
...
...
@@ -7,17 +7,21 @@ BEGIN {
require
'
t/test-lib.pm
';
}
my
$maintests
=
1
3
;
my
$maintests
=
1
4
;
my
$debug
=
'
debug
';
my
(
$issuer
,
$sp
,
$res
);
my
%handlerOR
=
(
issuer
=>
[]
,
sp
=>
[]
);
SKIP:
{
eval
"
use AuthCAS
";
no
warnings
'
redefine
';
eval
q#use AuthCAS#
;
if
(
$@
)
{
print
STDERR
$@
;
skip
'
AuthCAS not found
',
$maintests
;
}
*
AuthCAS::
get_https2
=
*mygethttps2
;
ok
(
$issuer
=
issuer
(),
'
Issuer portal
'
);
$handlerOR
{
issuer
}
=
\
@
Lemonldap::NG::Handler::Main::Reload::
_onReload
;
switch
('
sp
');
...
...
@@ -85,12 +89,11 @@ SKIP: {
ok
(
$url
=~
m#(http://auth.sp.com/)\?(ticket=[^&]+)$#
,
'
Get ticket in redirection
'
)
or
explain
(
$url
,
'
http://auth.sp.com/?ticket=...
'
);
$url
=
$
1
;
my
$query
=
$
2
;
# Back to SP
switch
('
sp
');
ok
(
$res
=
$sp
->
_get
(
$url
,
query
=>
$query
,
accept
=>
'
text/html
'
),
ok
(
$res
=
$sp
->
_get
(
'
/
'
,
query
=>
$query
,
accept
=>
'
text/html
'
),
'
Query SP with ticket
'
);
#print STDERR Dumper($res);
...
...
@@ -101,35 +104,17 @@ clean_sessions();
done_testing
(
count
()
);
# Redefine LWP methods for tests
no
warnings
'
redefine
';
sub
LWP
::UserAgent::request {
my
(
$self
,
$req
)
=
@_
;
ok
(
$req
->
uri
=~
m#http://auth.sp.com(.*)#
,
'
Request from SP to IdP
'
);
my
$url
=
$
1
;
my
$res
;
my
$s
=
$req
->
content
;
ok
(
$res
=
$sp
->
_post
(
$url
,
IO::
String
->
new
(
$s
),
length
=>
length
(
$s
),
type
=>
'
application/xml
',
),
'
Execute request
'
);
sub
mygethttps2
{
my
(
$host
,
$port
,
$path
,
$ssl_data
)
=
@_
;
ok
(
$path
=~
m#^(/[^\?]+)(?:\?(.*))?$#
,
"
Path to push to IdP:
$path
");
$path
=
$
1
;
my
$query
=
$
2
;
ok
(
$res
=
$issuer
->
_get
(
$path
,
query
=>
$query
),
'
Execute request
'
);
ok
(
(
$res
->
[
0
]
==
200
or
$res
->
[
0
]
==
400
),
'
Response is 200 or 400
'
)
or
explain
(
$res
->
[
0
],
"
200 or 400
"
);
ok
(
$issuer
->
getHeader
(
$res
,
'
Content-Type
'
)
=~
m#^application/xml#
,
'
Content is XML
'
)
or
explain
(
$res
->
[
1
],
'
Content-Type => application/xml
'
);
my
$httpResp
=
HTTP::
Response
->
new
(
$res
->
[
0
],
'
OK
'
);
while
(
my
$name
=
shift
@
{
$res
->
[
1
]
}
)
{
$httpResp
->
header
(
$name
,
shift
(
@
{
$res
->
[
1
]
}
)
);
}
$httpResp
->
content
(
join
(
'',
@
{
$res
->
[
2
]
}
)
);
count
(
4
);
return
$httpResp
;
count
(
2
);
my
@res
=
map
{
"
$_
\n
"
}
split
/\r?\n/
,
join
(
'',
@
{
$res
->
[
2
]
}
);
return
(
"
200
\n
",
"
\n
",
@res
);
}
sub
switch
{
...
...
Write
Preview