Menu
▾
▴
[popfile-commit] engine/UI HTML.pm,1.338,1.339 HTTP.pm,1.28,1.29
|
From: John Graham-C. <jgr...@us...> - 2005-02-15 04:24:04
|
Update of /cvsroot/popfile/engine/UI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20142/UI Modified Files: HTML.pm HTTP.pm Log Message: More work on v0.23.0 (Multi-user Support) Switch to using Cookies to keep client-side state concerning the current connection to POPFile's UI. Implement encrypted cookies and a login page that allow multiple users to be connected to POPFile's UI at the same time. Currently, it's possible to create users and login as people other than admin, but there's not a lot you can do with the users that are created. For the time being just login as admin (no password). My next commit will make multi-user mode actually work: there will be ability to logout, associations between POP3 accounts and POPFile users... DO NOT USE THIS FOR ANYTHING MORE THAN LOGGING IN AS ADMIN RIGHT NOW; STRANGE THINGS MAY HAPPEN! --- Classifer/Bayes.pm: Make API sessions keys much more robust and unlikely to clash by generating them randomly using a good random number source and using a long secure hash instead of my old system. UI/HTML.pm: New functions for cookie handling: handle_cookie__ (to deal with a received cookie), set_cookie__ (to send a cookie back to the client). password_page now asks for a username as well as a password and handle the creation of the API session and redirection with cookie. Remove the old api_session__ and replace with the sessions__ hash used to keep track of current sessions. Return the Set-Cookie: header. No hard-coded user '1' anywhere, all that is replaced with the user id derived by looking up the current session in the sessions__ hash. UI/HTTP.pm: New APIs decrypt_cookie__ and encrypt_cookie__ to handle encryption and decryption of cookies (with wrapping in base 64 for safety). Use Blowfish encryption with a randomly generated key each time POPFile is started. skins/default/*.thtml: Remove references to the old Session_Key (session= and hidden inputs) because it is no longer needed at all. skins/default/password-page.thtml: Password page now has a user name field and does not have an error message hard coded. skins/default/common-middle.thtml: The shutdown link is only available to admins, the tabs and shutdown are only available if you are logged in. skins/default/common-bottom.thtml: No information at all until you are logged in. languages/English.msg: Additional strings needed for the password page. Index: HTML.pm =================================================================== RCS file: /cvsroot/popfile/engine/UI/HTML.pm,v retrieving revision 1.338 retrieving revision 1.339 diff -C2 -d -r1.338 -r1.339 *** HTML.pm 14 Feb 2005 09:24:11 -0000 1.338 --- HTML.pm 15 Feb 2005 04:23:51 -0000 1.339 *************** *** 40,43 **** --- 40,55 ---- use Date::Parse; + # Needed for cookie handling + + use MIME::Base64; + use Crypt::CBC; + use Crypt::Random qw( makerandom_octet ); + use Digest::MD5 qw( md5_hex ); + [...3137 lines suppressed...] ! my ( $self, $session ) = @_; # Figure out what style sheet we are using ! my $root = 'skins/' . $self->user_config_( $self->{sessions__}{$session}{user}, 'skin' ) . '/'; my $css_file = $self->get_root_path_( $root . 'style.css' ); if ( !( -e $css_file ) ) { *************** *** 3450,3454 **** # output to $text ! my $templ = $self->load_template__( 'shutdown-page.thtml' ); for my $i ( 0..6 ) { --- 3614,3618 ---- # output to $text ! my $templ = $self->load_template__( 'shutdown-page.thtml','',$session ); for my $i ( 0..6 ) { Index: HTTP.pm =================================================================== RCS file: /cvsroot/popfile/engine/UI/HTTP.pm,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** HTTP.pm 4 Jan 2005 22:51:47 -0000 1.28 --- HTTP.pm 15 Feb 2005 04:23:53 -0000 1.29 *************** *** 35,38 **** --- 35,43 ---- use IO::Select; + # We use crypto to secure the contents of POPFile's cookies + + use Crypt::CBC; + use MIME::Base64; + # A handy variable containing the value of an EOL for the network *************** *** 49,52 **** --- 54,61 ---- my $self = POPFile::Module->new(); + # Crypto object used to encode/decode cookies + + $self->{crypto__} = ''; + bless $self; *************** *** 90,93 **** --- 99,111 ---- $self->{selector_} = new IO::Select( $self->{server_} ); + # Think of an encryption key for encrypting cookies using + + my $key = Crypt::Random::makerandom_octet( Length => 56, Strength => 1 ); + $self->{crypto__} = new Crypt::CBC( { 'key' => $key, + 'cipher' => 'Blowfish', + 'padding' => 'standard', + 'prepend_iv' => 0, + 'regenerate_key' => 0 } ); + return 1; } *************** *** 154,163 **** my $content_length = 0; my $content; $self->log_( 2, $request ); while ( my $line = $self->slurp_( $client ) ) { $content_length = $1 if ( $line =~ /Content-Length: (\d+)/i ); - # Discovered that Norton Internet Security was # adding HTTP headers of the form --- 172,182 ---- my $content_length = 0; my $content; + my $cookie = ''; $self->log_( 2, $request ); while ( my $line = $self->slurp_( $client ) ) { + $cookie = $1 if ( $line =~ /Cookie: (.+)/ ); $content_length = $1 if ( $line =~ /Content-Length: (\d+)/i ); # Discovered that Norton Internet Security was # adding HTTP headers of the form *************** *** 180,185 **** } if ( $request =~ /^(GET|POST) (.*) HTTP\/1\./i ) { ! $code = $self->handle_url( $client, $2, $1, $content ); $self->log_( 2, "HTTP handle_url returned code $code\n" ); --- 199,209 ---- } + # Handle decryption of a cookie header + + $cookie = $self->decrypt_cookie__( $cookie ); + if ( $request =~ /^(GET|POST) (.*) HTTP\/1\./i ) { ! $code = $self->handle_url( $client, $2, $1, ! $content, $cookie ); $self->log_( 2, "HTTP handle_url returned code $code\n" ); *************** *** 223,233 **** # $command The HTTP command used (GET or POST) # $content Any non-header data in the HTTP command # # ---------------------------------------------------------------------------- sub handle_url { ! my ( $self, $client, $url, $command, $content ) = @_; ! return $self->{url_handler_}( $self, $client, $url, $command, $content ); } --- 247,295 ---- # $command The HTTP command used (GET or POST) # $content Any non-header data in the HTTP command + # $cookie Decrypted cookie value (or null) # # ---------------------------------------------------------------------------- sub handle_url { ! my ( $self, $client, $url, $command, $content, $cookie ) = @_; ! return $self->{url_handler_}( $self, $client, $url, $command, ! $content, $cookie ); ! } ! ! # ---------------------------------------------------------------------------- ! # ! # decrypt_cookie__ ! # ! # $cookie The cookie value to decrypt ! # ! # ---------------------------------------------------------------------------- ! sub decrypt_cookie__ ! { ! my ( $self, $cookie ) = @_; ! ! $self->log_( 2, "Decrypt cookie: $cookie" ); ! ! $cookie =~ /popfile=([^\r\n]+)/; ! if ( defined( $1 ) ) { ! return $self->{crypto__}->decrypt( decode_base64( $1 ) ); ! } else { ! return ''; ! } ! } ! ! # ---------------------------------------------------------------------------- ! # ! # encrypt_cookie_ ! # ! # $cookie The cookie value to encrypt ! # ! # ---------------------------------------------------------------------------- ! sub encrypt_cookie_ ! { ! my ( $self, $cookie ) = @_; ! ! $self->log_( 2, "Encrypting cookie $cookie" ); ! return encode_base64( $self->{crypto__}->encrypt( $cookie ), '' ); } *************** *** 301,324 **** # ---------------------------------------------------------------------------- # - # http_redirect_ - tell the browser to redirect to a url - # - # $client The web browser to send redirect to - # $url Where to go - # - # Return a valid HTTP/1.0 header containing a 302 redirect message to the passed in URL - # - # ---------------------------------------------------------------------------- - sub http_redirect_ - { - my ( $self, $client, $url ) = @_; - - my $header = "HTTP/1.0 302 Found$eol" . 'Location: '; - $header .= $url; - $header .= "$eol$eol"; - print $client $header; - } - - # ---------------------------------------------------------------------------- - # # http_error_ - Output a standard HTTP error message # --- 363,366 ---- *************** *** 346,351 **** # $type Set this to the HTTP return type (e.g. text/html or image/gif) # ! # Returns the contents of a file formatted into an HTTP 200 message or an HTTP 404 if the ! # file does not exist # # ---------------------------------------------------------------------------- --- 388,393 ---- # $type Set this to the HTTP return type (e.g. text/html or image/gif) # ! # Returns the contents of a file formatted into an HTTP 200 message or ! # an HTTP 404 if the file does not exist # # ---------------------------------------------------------------------------- *************** *** 368,381 **** # like graphics and style sheets in cache. ! my @day = ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat' ); ! my @month = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' ); ! my $zulu = time; ! $zulu += 60 * 60; # 1 hour ! my ( $sec, $min, $hour, $mday, $mon, $year, $wday ) = gmtime( $zulu ); ! ! my $expires = sprintf( "%s, %02d %s %04d %02d:%02d:%02d GMT", # PROFILE BLOCK START ! $day[$wday], $mday, $month[$mon], $year+1900, ! $hour, 59, 0); # PROFILE BLOCK STOP ! my $header = "HTTP/1.0 200 OK$eol" . "Content-Type: $type$eol" . "Expires: $expires$eol" . "Content-Length: "; $header .= length($contents); --- 410,414 ---- # like graphics and style sheets in cache. ! my $expires = $self->zulu_offset_( 0, 1 ); my $header = "HTTP/1.0 200 OK$eol" . "Content-Type: $type$eol" . "Expires: $expires$eol" . "Content-Length: "; $header .= length($contents); *************** *** 387,390 **** --- 420,451 ---- } + # ---------------------------------------------------------------------------- + # + # zulu_offset_ + # + # $days Number of days to move forward + # $hours Number of hours to move forward + # + # Returns the current time in Zulu as a string suitable for passing to + # a web browser shifted forward $days or $hours. + # + # ---------------------------------------------------------------------------- + sub zulu_offset_ + { + my ( $self, $days, $hours ) = @_; + + my @day = ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat' ); + my @month = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', + 'Sep', 'Oct', 'Nov', 'Dec' ); + my $zulu = time; + $zulu += 60 * 60 * $hours; + $zulu += 24 * 60 * 60 * $days; + my ( $sec, $min, $hour, $mday, $mon, $year, $wday ) = gmtime( $zulu ); + + return sprintf( "%s, %02d %s %04d %02d:%02d:%02d GMT",# PROFILE BLOCK START + $day[$wday], $mday, $month[$mon], $year+1900, + $hour, 59, 0); # PROFILE BLOCK STOP + } + sub history { |
