Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

I've indeed configured Apache fallowing the POD of AuthCookie.

<VirtualHost ht2.dev> ServerName ht2.dev ServerAdmin wsl_research@websense.com DocumentRoot /var/www/html/ht2 Alias /js /var/www/html/js Alias /images /var/www/html/images Alias /ht2 /var/www/html/ht2 LoadModule perl_module /usr/lib/apache2/modules/mod_perl.so PerlModule Apache2::Reload PerlInitHandler Apache2::Reload PerlModule ModPerl::Registry PerlModule WSL::AuthCookie PerlSetVar AuthCookieDebug 3 PerlSetVar CCAPAuthPath / PerlSetVar CCAPAuthLoginScript /login.cgi <Location /ht2> AuthName CCAPAuth AuthType WSL::AuthCookie SetHandler perl-script Options +ExecCGI PerlOptions +GlobalRequest +ParseHeaders PerlAuthenHandler WSL::AuthCookie->authenticate PerlAuthzHandler WSL::AuthCookie->authorize Require valid-user </Location> <Files LOGIN> AuthName CCAPAuth AuthType WSL::AuthCookie PerlResponseHandler WSL::AuthCookie->login SetHandler perl-script Options +ExecCGI PerlOptions +GlobalRequest +ParseHeaders </Files> CustomLog /var/log/apache2/ht2-access.log combined ErrorLog /var/log/apache2/ht2-error.log </VirtualHost>

And I create the subclass of Apache2::AuthCookie by override its methods of authen_cred and anthen_ses_key.

package WSL::AuthCookie; use strict; use warnings; use Carp qw(carp confess); #use CGI; use Data::Dumper; use Net::LDAP; use WSL::Proxy; use Digest::MD5 qw(md5_hex); use Apache2::RequestRec; #use Apache2::Const qw(:common HTTP_FORBIDDEN); use base "Apache2::AuthCookie"; my $cycle = 300; my $secret = "STRbjLab"; sub authen_cred { my ($this, $r, @creds) = @_; carp Dumper(@creds); if ($this->is_authenticated($r, @creds) && $this->is_authorized($r, @creds)) { return $this->make_ticket($r, $creds[0]); } return; } sub authen_ses_key { my ($this, $r, $key) = @_; my $user = $this->check_ticket($r, $key); return $user if $user; return; } # Session summary -- $secret:$username:$expire # Session signatur -- md5_hex(Session summary) # Session key -- join ":", $user, $expire, $signature sub make_ticket { my ($this, $r, $user) = @_; my $expires = time() + $cycle; my $signature = md5_hex("$secret:$user:$expires"); my $key = join(":", $user, $expires, $signature); return $key; } sub check_ticket { my ($this, $r, $key) = @_; my ($user, $expires, $signature) = split(":", $key); my $hash = md5_hex("$secret:$user:$expires"); return undef if $signature ne $hash or $expires < time(); return $user; }

Then I write a login script to generate the login html.

#!/usr/bin/perl # Render the login form use strict; use warnings; use Carp qw|carp confess|; use Data::Dumper; use Apache2::RequestUtil; my $r; eval{$r = Apache2::RequestUtil->request;} || confess $@; my $prev = $r->prev; my $uri = $prev->uri; my $args = $prev->args; $uri .= "?$args" if $args; my $reason = $prev->subprocess_env('AuthCookieReason'); my $error = ""; if ($reason) { my $details; if ($reason eq "no_cookie") { $details = ""; } elsif ($reason eq "bad_cookie") { $details = "The cookie you presented is invalid. You must logi +n again!"; } elsif ($reason eq "bad_credentials") { $details = "Invalid Username/Password"; } else { $details = $reason; } $error = << "__REASON__"; <div class="alert alert-error"> $details </div> __REASON__ } print "content-type: text/html\n\n"; my $login_form = << "__LOGIN__"; <!DOCTYPE html> <html> <head> <title>HT2 - Login</title> <link href="/login.css" rel="stylesheet" type="text/css"> </head> <body> <div class="container"> $error <div class="modal"> <div class="modal-header" style="text-align:center"> <img width="350px" height="86px" src="img/security_labs_logo +_350.png"/> </div> <form class="form-horizontal" method="POST" action="/login"> <fieldset> <div class="modal-body"> <div class="control-group"> <label class="control-label" for="username">Username:< +/label> <div class="controls"> <input class="input" id="username" name="credential_ +0" autofocus="autofocus" type="text"> </div> </div> <div class="control-group"> <label class="control-label" for="password">Password:< +/label> <div class="controls"> <input class="input" id="password" name="credential_ +1" type="password"> </div> </div> <div class="hidden"> <input class="input" id="destination" name="destinatio +n" type="text" value="$uri"> </div> </div> </fieldset> <div class="modal-footer"> <button type="submit" class="btn btn-primary"> <i class="icon-lock icon-white"></i> Login </button> </div> </form> </div> </div> </body> </html> __LOGIN__ print $login_form;

But after all these efforts I just get a error. Annoying!

Anything wrong???

Any ideas???


In reply to Re^2: Getting an error when invoking Apache2::RequestUtil->request by CloudSurf
in thread Getting an error when invoking Apache2::RequestUtil->request by CloudSurf

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others having an uproarious good time at the Monastery: (4)
    As of 2018-07-17 00:23 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















      Results (353 votes). Check out past polls.

      Notices?