* Added some comments (including some XXX comments where I realised we had missing code)

* Added implicit data to the hash passed to the string expander from the generic output service
* To support the implicit data, added a |hash| stub method to the Session.pm module (and changed the already implemented version in the descendant user service to take this into account)
* To support the implicit data, added |hash| and |getArguments| methods to the Input.pm module (and implemented |getArguments| in the Arguments.pm module)
* To support the implicit data, made the Program.pm module keep track of the executing command
* To support the implicit data, added |hash| and |name| methods to the Program.pm module (actually, |name| was already assumed to exist in other parts of the codebase)
* Corrected trivial semantic mistake in Program.pm's |verifyInput| method
* Added a way to get a user not by username but by a specific address (modifies the user service and the user data source and it's MySQL implementation)
* Implemented GenericOutputs.pm, an implementation of 'dispatcher.output.generic' and 'dataSource.strings.default' for some strings used by other parts of PLIF (currently only supports 'stdout' and 'http' protocols, and minimally at that)
* Implemented Login.pm, a helper module that implements user authentication, user creation and the sending of a new password if it is forgotten, a utility method |hasRight| to ensure that the authenticated user has a particular right (resulting in a message if not), and various routines to support all this.

webtools/PLIF/PLIF/DataSource/User.pm

@@ -49,6 +49,7 @@ sub getUserByUsername {
     # decent databases can do this in one go. Those that can't can do
     # it in a generic two-step process:
     return $self->getUserByID($app, $self->getUserIDByUsername($app, $username));
+    # XXX no error checking! if getUserID... return undef, return ()!
     # return the same as getUserByID()
 }
 
@@ -56,7 +57,24 @@ sub getUserIDByUsername {
     my $self = shift;
     my($app, $username) = @_;
     $self->notImplemented();
-    # return userID
+    # return userID or undef
+}
+
+sub getUserByContactDetails {
+    my $self = shift;
+    my($app, $contactName, $address) = @_;
+    # decent databases can do this in one go. Those that can't can do
+    # it in a generic two-step process:
+    return $self->getUserByID($app, $self->getUserIDByContactDetails($app, $username));
+    # XXX no error checking! if getUserID... return undef, return ()!
+    # return the same as getUserByID()
+}
+
+sub getUserIDByContactDetails {
+    my $self = shift;
+    my($app, $contactName, $address) = @_;
+    $self->notImplemented();
+    # return userID or undef
 }
 
 sub getUserByID {

webtools/PLIF/PLIF/DataSource/User/MySQL.pm

@@ -48,8 +48,23 @@ sub getUserIDByUsername {
     return $self->database($app)->execute('SELECT userData.userID
                                            FROM userData, userDataTypes
                                            WHERE userData.fieldID = userDataTypes.fieldID
+                                           AND userDataTypes.category = 'contact'
                                            AND CONCAT(userDataTypes.data, userData.data) = ?', $username)->row->[0];
-    # return userID
+    # XXX no error checking!
+    # return userID or undef
+}
+
+sub getUserIDByContactDetails {
+    my $self = shift;
+    my($app, $contactName, $address) = @_;
+    return $self->database($app)->execute('SELECT userData.userID
+                                           FROM userData, userDataTypes
+                                           WHERE userData.fieldID = userDataTypes.fieldID
+                                           AND userDataTypes.category = 'contact'
+                                           AND userDataTypes.name = ?
+                                           AND userData.data = ?', $contactName, $address)->row->[0];
+    # XXX no error checking!
+    # return userID or undef
 }
 
 sub getUserByID {

webtools/PLIF/PLIF/Input.pm

@@ -74,6 +74,22 @@ sub peekArgument {
     return undef;
 }
 
+# returns all the arguments in a form of a hash:
+#  key => value
+sub getArguments {
+    my $self = shift;
+    $self->notImplemented();
+}
+
+sub hash {
+    my $self = shift;
+    return {
+        'arguments' => $self->getArguments(),
+        'protocol' => $self->defaultOutputProtocol(),
+        # XXX also UA, etc...
+    };
+}
+
 # 'username' and 'password' are two out of band arguments that may be
 # provided as well, they are accessed as properties of the input
 # object (e.g., |if (defined($input->username)) {...}|).  Input
@@ -82,6 +98,12 @@ sub peekArgument {
 # username would be "AIM: HixieDaPixie". Other services, which get the
 # username from the user (e.g. HTTP), should pass the username
 # directly. See the user service for more details.
+#
+# 'username' should only be provided if the user attempted to log in.
+#
+# 'address' is an out of band argument that should only be provided
+# for input devices that know the address of the user (and can thus
+# construct the username).
 
 
 # XXX I don't like having these here:

webtools/PLIF/PLIF/Input/Arguments.pm

@@ -59,6 +59,18 @@ sub getArgument {
     }
 }
 
+# Returns all the arguments present.
+sub getArguments {
+    my $self = shift;
+    my $result = {};
+    foreach my $argument (keys %$self) {
+        if ($argument =~ /^argument (.*)$/o) {
+            $result->{$1} = \@{$self->{$argument}};
+        }
+    }
+    return $result;
+}
+
 # Returns the values given for that argument if it already exists,
 # otherwise undef. In a scalar context, returns the first value (or
 # undef if the argument was never given). In an array context, returns

webtools/PLIF/PLIF/Input/CommandLine.pm

@@ -90,7 +90,7 @@ sub createArgument {
             $self->app->output->request($argument);
             # get input from user :-)
             my $term = Term::ReadLine->new($self->app->name);
-            my $value = $term->readline(''); # argument is prompt            
+            my $value = $term->readline(''); # (the parameter passed is the prompt, if any)
             # if we cached the input device:
             # $term->addhistory($value);
             $self->setArgument($argument, $value);

webtools/PLIF/PLIF/Output/Generic.pm

@@ -113,6 +113,7 @@ sub output {
         $expander = $self->app->getService('string.expander');
         $self->assert($expander, 1, 'Could not find a string expander.');
     }
+    $self->fillData($data);
     $self->outputter->output($self->app, $session, $expander->expand($self->app, $session, $self->actualProtocol, $string, $data));
 }
 
@@ -126,6 +127,14 @@ sub methodMissing {
     my $self = shift;
     my($method, @arguments) = @_;
     if (not $self->app->dispatchMethod('dispatcher.output.'.$self->actualProtocol, 'output', $method, $self, @arguments)) {
-        $self->SUPER::methodMissing(@_); # this does the same, but for 'dispatcher.output.generic' handlers
+        $self->SUPER::methodMissing(@_); # this does the same, but for 'dispatcher.output.generic' handlers, since that is our $self->protocol
     }
 }
+
+sub fillData {
+    my $self = shift;
+    my($data) = @_;
+    $data->{'app'} = $app->hash;
+    $data->{'session'} = $self->session->hash;
+    $data->{'input'} = $app->input->hash;
+}

webtools/PLIF/PLIF/Program.pm

@@ -55,8 +55,10 @@ sub run {
             $self->objects([]);
             if ($self->verifyInput()) {
                 if ($self->input->command) {
+                    $self->command($command);
                     $self->dispatch($self->input->command);
                 } else {
+                    $self->command('');
                     $self->noCommand();
                 }
             } # verifyInput should deal with the errors
@@ -65,6 +67,7 @@ sub run {
             $self->dump(3, "previous command didn't go over well: $@");
             $self->output->reportFatalError($@);
         }
+        $self->command(undef);
         # In case we used a progressive output device, let it shut
         # down.  It's important to do this, because it holds a
         # reference to us and we wouldn't want a memory leak...
@@ -135,7 +138,7 @@ sub output {
 sub verifyInput {
     my $self = shift;
     # we invoke all the input verifiers until one fails
-    my($result) = $self->getSelectingServiceList('input.verify')->verifyInput($self);
+    my $result = $self->getSelectingServiceList('input.verify')->verifyInput($self);
     if (defined($result)) { 
         # if one failed, then the result will be the object that should report the error
         $result->reportInputVerificationError($self);
@@ -150,6 +153,11 @@ sub selectOutputProtocol {
     return $self->input->defaultOutputProtocol;
 }
 
+sub hash {
+    my $self = shift;
+    return { 'name' => $self->name };
+}
+
 
 # Implementation Specific Methods
 # At least some of these should be overriden by real applications
@@ -184,3 +192,8 @@ sub noCommand {
     my $self = shift;
     $self->unknownCommand(@_);
 }
+
+sub name {
+    my $self = shift;
+    $self->notImplemented();
+}

webtools/PLIF/PLIF/Service/Coses.pm

@@ -130,6 +130,9 @@ sub expand {
                 } elsif ($node eq 'text') {
                     if ($attributes->{'value'}) {
                         $result .= $self->evaluateExpression($attributes->{'value'}, $scope);
+                        # XXX we need to also support:
+                        #   insert text escaped (as HTML, XML, URI, etc)
+                        #   insert a hash as a particular data structure (CGI arguments, an XML fragment, etc)
                         next node; # skip contents if attribute 'value' is present
                     } 
                 } elsif ($node eq 'br') {

webtools/PLIF/PLIF/Service/GenericOutputs.pm

@@ -0,0 +1,80 @@
+# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
+#
+# This file is MPL/GPL dual-licensed under the following terms:
+# 
+# The contents of this file are subject to the Mozilla Public License
+# Version 1.1 (the "License"); you may not use this file except in
+# compliance with the License. You may obtain a copy of the License at
+# http://www.mozilla.org/MPL/
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and
+# limitations under the License.
+#
+# The Original Code is PLIF 1.0.
+# The Initial Developer of the Original Code is Ian Hickson.
+#
+# Alternatively, the contents of this file may be used under the terms
+# of the GNU General Public License Version 2 or later (the "GPL"), in
+# which case the provisions of the GPL are applicable instead of those
+# above. If you wish to allow use of your version of this file only
+# under the terms of the GPL and not to allow others to use your
+# version of this file under the MPL, indicate your decision by
+# deleting the provisions above and replace them with the notice and
+# other provisions required by the GPL. If you do not delete the
+# provisions above, a recipient may use your version of this file
+# under either the MPL or the GPL.
+
+package PLIF::Service::GenericOutputs;
+use strict;
+use vars qw(@ISA);
+use PLIF::Service;
+@ISA = qw(PLIF::Service);
+1;
+
+sub provides {
+    my $class = shift;
+    my($service) = @_;
+    return ($service eq 'dispatcher.output.generic' or 
+            $service eq 'dataSource.strings.default' or
+            $class->SUPER::provides($service));
+}
+
+# dispatcher.output.generic
+# this is typically used by input devices
+sub outputRequest {
+    my $self = shift;
+    my($app, $argument) = @_;
+    $output->output(undef, 'request', {
+        'command' => $app->command,
+        'argument' => $argument,
+    });
+}
+
+# dispatcher.output.generic
+sub outputReportFatalError {
+    my $self = shift;
+    my($error) = @_;
+    $self->output(undef, 'error', {
+        'error' => $error,
+    });   
+}
+
+# dataSource.strings.default
+sub getDefaultString {
+    my $self = shift;
+    my($app, $protocol, $string) = @_;
+    if ($protocol eq 'stdout') {
+        if ($string eq 'request') {
+            return '<text>'<text variable="(data.argument)"/>'? </text>';
+        } elsif ($string eq 'error') {
+            return '<text>Error:<br/><text variable="(data.error)"/></br/></text>';
+        }
+    } elsif ($protocol eq 'http') {
+        if ($string eq 'error') {
+            return '<text>HTTP/1.1 500 Internal Error<br/>Content-Type: text/plain<br/><br/>Error:<br/><text variable="(data.error)"/></text>';
+        }
+    }
+    return; # nope, sorry
+}

webtools/PLIF/PLIF/Service/Login.pm

@@ -0,0 +1,229 @@
+# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
+#
+# This file is MPL/GPL dual-licensed under the following terms:
+# 
+# The contents of this file are subject to the Mozilla Public License
+# Version 1.1 (the "License"); you may not use this file except in
+# compliance with the License. You may obtain a copy of the License at
+# http://www.mozilla.org/MPL/
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and
+# limitations under the License.
+#
+# The Original Code is PLIF 1.0.
+# The Initial Developer of the Original Code is Ian Hickson.
+#
+# Alternatively, the contents of this file may be used under the terms
+# of the GNU General Public License Version 2 or later (the "GPL"), in
+# which case the provisions of the GPL are applicable instead of those
+# above. If you wish to allow use of your version of this file only
+# under the terms of the GPL and not to allow others to use your
+# version of this file under the MPL, indicate your decision by
+# deleting the provisions above and replace them with the notice and
+# other provisions required by the GPL. If you do not delete the
+# provisions above, a recipient may use your version of this file
+# under either the MPL or the GPL.
+
+package PLIF::Service::Login;
+use strict;
+use vars qw(@ISA);
+use PLIF::Service;
+@ISA = qw(PLIF::Service);
+1;
+
+sub provides {
+    my $class = shift;
+    my($service) = @_;
+    return ($service eq 'input.verify' or 
+            $service eq 'input.verify.user.generic' or 
+            $service eq 'user.login' or
+            $service eq 'dispatcher.commands' or 
+            $service eq 'dispatcher.output.generic' or 
+            $service eq 'dataSource.strings.default' or
+            $class->SUPER::provides($service));
+}
+
+# input.verify
+sub verifyInput {
+    my $self = shift;
+    my($app) = @_;
+    # let's see if there are any protocol-specific user authenticators
+    my @result = $self->getSelectingServiceList('input.verify.user.'.$app->input->protocol)->authenticateUser($app);
+    if (not @result) { 
+        # ok, let's try the generic authenticators...
+        @result = $self->getSelectingServiceList('input.verify.user.generic')->authenticateUser($app);
+    }
+    # now let's see what that gave us
+    if (@result) {
+        # horrah, somebody knew what to do!
+        if (defined($result[0])) {
+            $app->addObject($result[0]); # they will have returned a user object
+        } else {
+            # hmm, so apparently user is not authentic
+            return $self; # supports user.login (reportInputVerificationError)
+        }
+    }
+    return; # nope, nothing to see here... (no error, anyway)
+}
+
+# input.verify.user.generic
+sub authenticateUser {
+    my $self = shift;
+    my($app) = @_;
+    if (defined($app->input->username)) {
+        return $app->getService('user.factory')->getUserByCredentials($app->input->username, $app->input->password);
+    } else {
+        return; # return nothing (not undef)
+    }
+}
+
+# input.verify
+sub reportInputVerificationError {
+    my $self = shift;
+    my($app) = @_;
+    $app->output->loginFailed(1); # 1 means 'invalid username/password'
+}
+
+# dispatcher.commands
+sub cmdSendPassword {
+    my $self = shift;
+    my($app) = @_;
+    my $protocol = $app->input->getAttribute('protocol');
+    my $address = $app->input->getAttribute('address');
+    if (defined($method) and defined($address)) {
+        my $user = $app->getService('user.factory')->getUserByContactDetails($app, $protocol, $address);
+        my $password;
+        if (defined($user)) {
+            $password = $self->changePassword($app, $user);
+        } else {
+            ($user, $password) = $self->createUser($app, $protocol, $address);
+        }
+        $self->sendPassword($app, $user, $protocol, $password);
+    } else {
+        $app->output->loginFailed(0); # 0 means 'no username/password'
+    }
+}
+
+# user.login
+sub hasRight {
+    my $self = shift;
+    my($app, $right) = @_;
+    my $user = $self->getObject('user');
+    if (defined($user)) {
+        if ($user->hasRight($right)) {
+            return $user;
+        } else {
+            $app->output->loginInsufficient($right);
+        }
+    } else {
+        $self->requireLogin($app);
+    }
+    return undef;
+}
+
+# user.login
+# this assumes user is not logged in
+sub requireLogin {
+    my $self = shift;
+    my($app) = @_;
+    my $address = $app->input->address;
+    if (defined($address) and not defined($app->getService('user.factory')->getUserByContactDetails($app, $app->input->protocol, $address))) {
+        my($user, $password) = $self->createUser($app, $app->input->protocol, $address);
+        $self->sendPassword($app, $user, $app->input->protocol, $password);
+    } else {
+        $app->output->loginFailed(0);
+    }
+}
+
+# dispatcher.output.generic
+sub outputLoginInsufficient {
+    my $self = shift;
+    my($app, $output, $right) = @_;
+    $output->output(undef, 'loginAccessDenied', {
+        'right' => $right,
+    });   
+}
+
+# dispatcher.output.generic
+sub outputLoginFailed {
+    my $self = shift;
+    my($app, $output, $tried) = @_;
+    $output->output(undef, 'loginFailed', {
+        'tried' => $tried,
+    });   
+}
+
+# dispatcher.output.generic
+sub outputLoginDetailsSent {
+    my $self = shift;
+    my($app, $output, $address, $protocol) = @_;
+    $output->output(undef, 'loginDetailsSent', {
+        'address' => $address,
+        'protocol' => $protocol,
+    });   
+}
+
+# dispatcher.output.generic
+sub outputLoginDetails {
+    my $self = shift;
+    my($app, $output, $username, $password) = @_;
+    $output->output(undef, 'loginDetails', {
+        'username' => $username,
+        'password' => $password,
+    });   
+}
+
+# dataSource.strings.default
+sub getDefaultString {
+    my $self = shift;
+    my($app, $protocol, $string) = @_;
+    if ($protocol eq 'stdout') {
+        if ($string eq 'loginAccessDenied') {
+            return '<text>Access Denied<br/></text>';
+        } elsif ($string eq 'loginFailed') {
+            return '<text><if lvalue="(data.tried)" condition="=" rvalue="1">Wrong username or password.</if><else>You must give your username or password.</else><br/><!-- XXX offer to create an account or send the password --></br/></text>';
+        } elsif ($string eq 'loginDetailsSent') {
+            return '<text>Login details were sent. (Protocol: <text variable="(data.protocol)"/>; Address: <text variable="(data.address)"/>)</br/></text>';
+        }
+    } elsif ($protocol eq 'http') {
+        if ($string eq 'loginAccessDenied') {
+            return '<text>HTTP/1.1 401 Access Denied<br/>Content-Type: text/plain<br/><br/>Access Denied</text>';
+        } elsif ($string eq 'loginFailed') {
+            return '<text>HTTP/1.1 401 Login Required<br/>WWW-Authenticate: Basic realm="<text variable="(data.app.name)"/>"<br/>Content-Type: text/plain<br/><br/><if lvalue="(data.tried)" condition="=" rvalue="1">Wrong username or password.</if><else>You must give your username or password.</else></br/><!-- XXX offer to create an account or send the password --></text>';
+        } elsif ($string eq 'loginDetailsSent') {
+            return '<text>HTTP/1.1 200 OK<br/>Content-Type: text/plain<br/><br/>Login details were sent.<br/>Protocol: <text variable="(data.protocol)"/><br/>Address: <text variable="(data.address)"/>)</text>';
+        }
+    }
+    return; # nope, sorry
+}
+
+
+# internal routines
+
+sub changePassword {
+    my $self = shift;
+    my($app, $user) = @_;
+    my($password, $crypt) = $app->getService('service.passwords')->newPassword();
+    $user->password($crypt);
+    return $password;
+}
+
+sub createUser {
+    my $self = shift;
+    my($app, $protocol, $address) = @_;
+    my($password, $crypt) = $app->getService('service.passwords')->newPassword();
+    my $user = $app->getService('user.factory')->getNewUser($app, $crypt);
+    $user->getField('contact', $protocol)->data = $address;
+    return ($user, $password);
+}
+
+sub sendPassword {
+    my $self = shift;
+    my($app, $user, $protocol, $password) = @_;
+    my $field = $user->hasField('contact', $protocol);
+    $self->assert(defined($field), 1, 'Tried to send a password using a protocol that the user has no mention of!'); # XXX grammar... :-)
+    $app->output($protocol, $user)->loginDetails($app, $field->username, $password);
+    $app->output->loginDetailsSent($app, $field->address, $protocol);
+}

webtools/PLIF/PLIF/Service/Session.pm

@@ -59,3 +59,7 @@ sub getAddress {
     my($protocol) = @_;
     return undef; # 'not known over this protocol'
 }
+
+sub hash {
+    return {};    
+}

webtools/PLIF/PLIF/Service/User.pm

@@ -71,6 +71,17 @@ sub getUserByUsername {
     }
 }
 
+sub getUserByContactDetails {
+    my $self = shift;
+    my($app, $contactName, $address) = @_;
+    my(@data) = $app->getService('dataSource.user')->getUserByContactDetails($app, $contactName, $address);
+    if (@data) {
+        return $self->objectCreate($app, @data);
+    } else {
+        return undef;
+    }
+}
+
 sub getUserByID {
     my $self = shift;
     my($app, $id) = @_;
@@ -211,14 +222,13 @@ sub resetAddressChange {
 
 sub hash {
     my $self = shift;
-    my $result = {
-        'userID' => $self->userID,
-        'mode' => $self->mode,
-        'adminMessage' => $self->adminMessage,
-        'fields' => {},
-        'groups' => $self->groups,
-        'rights' => keys(%{$self->rights});
-    };
+    my $result = $self->SUPER::hash();
+    $result->{'userID'} = $self->userID,
+    $result->{'mode'} = $self->mode,
+    $result->{'adminMessage'} = $self->adminMessage,
+    $result->{'groups'} = $self->groups,
+    $result->{'rights'} = keys(%{$self->rights});
+    $result->{'fields'} = {},
     foreach my $field (values(%{$self->fieldsByID})) {
         # XXX should we also pass the field metadata on? (e.g. typeData)
         $result->{'fields'}->{$field->fieldID} = $field->data;