Initial auth example, something is a bit wonky with the session?

diff --git a/examples/auth/auth.cgi b/examples/auth/auth.cgi
new file mode 100644 (file)
index 0000000..8d9dfb2
--- /dev/null
+++ b/examples/auth/auth.cgi
@@ -0,0 +1,154 @@
+#!/usr/bin/env perl
+
+package AuthApp;
+
+use lib 'lib';
+use Web::Simple;
+use Authen::Passphrase::SaltedDigest;
+with 'Web::Simple::Application::Role::Authentication';
+
+use AuthApp::Schema;
+
+has 'schema' => (is => 'lazy');
+has 'deployed' => (is => 'rw');
+
+sub dispatch_request {
+    my ($self) = @_;
+    
+    my $user;
+    $self->check_authenticated($user);
+
+    sub (GET + /) {
+        my ($self) = @_;
+
+        return [ 200, [ 'Content-type', 'text/html' ], [ $self->main_page($user)  ]];
+    },
+
+    sub (POST + /login + %username=&password=) {
+        my ($self, $usern, $passw) = @_;
+        
+        my $user = $self->get_check_user($usern, $passw);
+        
+        if($user) {
+            return ($self->set_authenticated($user), 
+                    [ 303, [ 'Content-type', 'text/html', 
+                             'Location', '/' ], 
+                      [ 'Login succeeded, back to <a href="/"></a>' ]]);
+        } else {
+            return [ 200, [ 'Content-type', 'text/html' ], [ 'Login failed' ]];
+        }
+    },
+    sub (POST + /register + %username=&password=) {
+        my ($self, $username, $password) = @_;
+
+        ## FIXME: Check length of inputs!
+        my $newuser = $self->create_user($username, $password);
+
+        if($newuser) {
+            return 
+                [ 303, [ 'Content-type', 'text/html', 
+                         'Location', '/' ], 
+                  [ 'Registration succeeded, back to <a href="/"></a>' ]];
+        } else {
+            return [ 200, [ 'Content-type', 'text/html' ], [ 'Registration failed' ]];
+        }
+    },
+    sub (GET + /logout) {
+        my ($self) = @_;
+
+        if($user) {
+            $user = undef;
+        }
+
+        return ($self->logout,
+                [ 303, [ 'Content-type', 'text/html', 
+                         'Location', '/' ], 
+                      [ 'Logout succeeded, back to <a href="/"></a>' ]]);
+    },
+}
+
+## Implement these two (examples based on DBIx::Class):
+
+## _ident_from_user, return a unique way of identifying a user, this
+## will be stored in the session
+sub _ident_from_user {
+  my ($self, $user) = @_;
+  return $user->ident_condition;
+}
+
+## _user_from_ident, return a user object, given the unique user identifier
+sub _user_from_ident {
+  my ($self, $ident) = @_;
+  return $self->users_rs->find($ident);
+}
+
+sub _build_schema {
+    my ($self) = @_;
+
+    my $schema = AuthApp::Schema->connect("dbi:SQLite:auth.db");
+    if(!$self->deployed) {
+        $schema->deploy;
+        $self->deployed(1);
+    }
+
+    return $schema;
+}
+
+sub get_check_user {
+    my ($self, $username, $password) = @_;
+    
+    my $user = $self->schema->resultset('User')->find({ username => $username });
+    if($user && $user->password->match($password)) {
+        return $user;
+    }
+    
+    return;
+}
+
+sub create_user {
+    my ($self, $username, $password) = @_;
+    
+    my $user = $self->schema->resultset('User')->find({ username => $username });
+    if($user) {
+        warn "Cowardly refusing to re-create an existing user $username";
+        return;
+    }
+
+    $user = $self->schema->resultset('User')->create({
+        username => $username,
+        password => Authen::Passphrase::SaltedDigest->new(algorithm => "SHA-1", salt_random => 20, passphrase=>$password),
+                                             });
+    
+    return $user;
+}
+
+sub main_page {
+    my ($self, $user) = @_;
+
+    my $is_user = $user ? $user->username . ' is logged in. <a href="logout">Logout</a>' : <<FORM;
+Login:<br>
+   <form action="login" method="post">
+    Username: <input type="text" name="username"><br>
+    Password: <input type="password" name="password"><br>
+    <input type="submit">
+   </form>
+Register:<br>
+   <form action="register" method="post">
+    Username: <input type="text" name="username"><br>
+    Password: <input type="password" name="password"><br>
+    <input type="submit">
+   </form>
+FORM
+
+    return << "HTML";
+<html>
+  <head><title>Auth App</title></head>
+  <body>
+  $is_user
+  </body>
+</html>
+HTML
+
+}
+
+AuthApp->run_if_script;

diff --git a/examples/auth/auth.db b/examples/auth/auth.db
new file mode 100644 (file)
index 0000000..060d5dc
Binary files /dev/null and b/examples/auth/auth.db differ

diff --git a/examples/auth/lib/AuthApp/Schema.pm b/examples/auth/lib/AuthApp/Schema.pm
new file mode 100644 (file)
index 0000000..373cc86
--- /dev/null
+++ b/examples/auth/lib/AuthApp/Schema.pm
@@ -0,0 +1,7 @@
+package AuthApp::Schema;
+
+use base 'DBIx::Class::Schema';
+
+__PACKAGE__->load_namespaces();
+
+1;

diff --git a/examples/auth/lib/AuthApp/Schema/Result/User.pm b/examples/auth/lib/AuthApp/Schema/Result/User.pm
new file mode 100644 (file)
index 0000000..aa865b1
--- /dev/null
+++ b/examples/auth/lib/AuthApp/Schema/Result/User.pm
@@ -0,0 +1,27 @@
+package AuthApp::Schema::Result::User;
+
+use base 'DBIx::Class::Core';
+
+__PACKAGE__->load_components(qw(InflateColumn::Authen::Passphrase));
+__PACKAGE__->table('users');
+__PACKAGE__->add_columns(
+    id => {
+        data_type => 'integer',
+        is_auto_increment => 1,
+    },
+    username => {
+        data_type => 'TINYTEXT',
+    },
+    password => {
+        data_type => 'varchar',
+        size => 255,
+        inflate_passphrase => 'rfc2307',
+    },
+    );
+
+__PACKAGE__->set_primary_key('id');
+__PACKAGE__->add_unique_constraint('username' => ['username']);
+
+1;
+
+        

diff --git a/examples/auth/lib/Web/Simple/Application/Role/Authentication.pm b/examples/auth/lib/Web/Simple/Application/Role/Authentication.pm
new file mode 100644 (file)
index 0000000..5cadf24
--- /dev/null
+++ b/examples/auth/lib/Web/Simple/Application/Role/Authentication.pm
@@ -0,0 +1,48 @@
+package Web::Simple::Application::Role::Authentication;
+
+use Plack::Request;
+use Plack::Middleware::Session;
+use Moo::Role;
+
+requires '_ident_from_user';
+requires '_user_from_ident';
+
+## $_[PSGI_ENV] is setup by Web::Simple which we don't see here..
+my $PSGI_ENV = -1;
+
+sub set_authenticated {
+  my ($self, $user) = @_;
+  my $uc = $self->_ident_from_user($user);
+  return (
+    $self->ensure_session,
+    sub () { $_[$PSGI_ENV]->{'psgix.session'}{'user_info'} = $uc; }
+  );
+}
+
+sub check_authenticated {
+  my ($self) = @_;
+  my $user_ref = \$_[1];
+  return (
+    $self->ensure_session,
+    sub () {
+      if (my $uc = $_[$PSGI_ENV]->{'psgix.session'}{'user_info'}) {
+        ${$user_ref} = $self->_user_from_ident($uc);
+      }
+      return;
+    }
+  );
+}
+
+sub _create_session {
+  Plack::Middleware::Session->new(store => 'File');
+}
+
+sub ensure_session {
+  my ($self) = @_;
+  sub () {
+    return if $_[$PSGI_ENV]->{'psgix.session'};
+    $self->_create_session;
+  }
+}
+
+1;