Merge pull request #12 from einhverfr/master

Dancer routings

.travis.yml

@@ -12,6 +12,8 @@ env:
 before_install:
    - "cpanm DBI"
    - "cpanm DBD::Pg"
+   - 'cpanm Template'
+   - "cpanm Dancer"
    - "cpanm Try::Tiny"
    - "cpanm Test::More"
    - "cpanm Test::Exception"

Makefile.PL

@@ -22,6 +22,8 @@ WriteMakefile(
     PREREQ_PM => {
         "DBI"                      => 0,
         "DBD::Pg"                  => 0,
+        "Dancer"                   => 0,
+        "Template"                 => 0,
         "Try::Tiny"                => 0,
         "PGObject::Simple::Role"   => 0,
         "PGObject::Util::DBMethod" => 0,

lib/App/LedgerSMB/Admin/Auth.pm

@@ -0,0 +1,99 @@
+=head1 NAME
+
+App::LedgerSMB::Admin::Auth - Authenticate Web Users for LSMB Admin Tasks
+
+=cut
+
+package App::LedgerSMB::Admin::Auth;
+use Dancer ':syntax';
+use Dancer::Response;
+use HTTP::Headers;
+use MIME::Base64;
+use strict;
+use warnings;
+
+=head1 SYNOPSIS
+
+ my $db = authenticate(host => 'localhost', port => 5432, dbname => 'lsmb');
+
+=head1 FUNCTIONS
+
+=head2 authenticate
+
+This function grabs the parameters of host and port from the arg hash and the
+username and password from the authentication header, and returns a db object
+with a connection.  If the connection fails, it returns a 401 error.
+
+Currently only basic auth is supported but there are plans to add krb5 auth
+in the near future.
+
+We currently return a 401 any time the db connection fails for any reason.
+This is to prevent using the tool to scan for db servers for further attacks.
+
+=cut
+
+sub authenticate {
+    my %args = @_;
+    my $header = request->header('Authorization');
+    my ($user, $password) = split(/:/, (MIME::Base64::decode($1) || ":"));
+    return _fail_auth() unless $user;
+    my $db = App::LedgerSMB::Admin::Database->new(%args,
+                                                  username => $user,
+                                                  password => $password,
+    );
+    return $db if $db->connect;
+    return _fail_auth();
+}
+
+sub _fail_auth {
+    my $authmsg = 'Authorization Required';    
+    return halt(Dancer::Response->new(
+        status => 401,
+        content => $authmsg,
+        headers => [
+            'Content-Type' => 'text/plain',
+            'Content-Length' => length($authmsg),
+            'WWW-Authenticate' => 'Basic realm="LedgerSMB Admin"',
+        ]
+    ));
+}
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2014 Chris Travers.
+
+This program is distributed under the (Revised) BSD License:
+L<http://www.opensource.org/licenses/BSD-3-Clause>
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+* Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+* Neither the name of Chris Travers's Organization
+nor the names of its contributors may be used to endorse or promote
+products derived from this software without specific prior written
+permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+=cut
+
+1;

lib/App/LedgerSMB/Admin/Database/Routings.pm

@@ -0,0 +1,114 @@
+package App::LedgerSMB::Admin::Database::Routings;
+use Dancer ':syntax';
+use Dancer::Serializer;
+use Dancer::Plugin::Ajax;
+use Template;
+
+=head1 NAME
+
+App::LedgerSMB::Admin::Database::Routings - Dancer App for LSMB DB Admin
+
+=cut
+
+=head1 URL LAYOUT
+
+All urls occur in the /lsmbadmin/1.0/ path from the document root.
+
+=cut
+
+prefix '/lsmbadmin/1.0';
+
+=head2 Per Server URLs
+
+The server urls are then parameterized with host and port.
+
+For each server the following resources are present:
+
+=over
+
+=item dbs - list databases (get only)
+
+=item new - new database
+
+=item globals - backup of server globals (put to restore)
+
+=back
+
+get retrieves information, post updates the information.
+
+The complete urls then become, for a server at localhost and a port of 5432, 
+off a base of:
+
+ /lsmbadmin/1.0/localhost/5432/
+
+So the database list would be found at
+
+ /lsmbadmin/1.0/localhost/5432/dbs
+
+=cut
+
+get  '/:host/:port/dbs'     => sub { template 'dblist'  => _list_dbs() };
+ajax  '/:host/:port/dbs'    => sub { to_json(_lsmb_dbs()) };
+get  '/:host/:port/new'     => sub { template 'new_db'  => {} };
+post '/:host/:port/new'     => sub { template 'db_info' => _createdb() };
+ajax  '/:host/:port/new'    => sub { to_json(createdb()) };
+get  '/:host/:port/globals' => sub { _backup_globals() };
+put  '/:host/:port/globals' => sub { template 'restored' => _restore_globals()};
+ajax '/:host/:port/globals' => sub { to_json(_restore_globals()) };
+
+=head2 Per Database URLs
+
+=cut
+
+get  '/:host/:port/db/:dbname/' => sub { template 'db_info' => _db_info(); };
+post '/:host/:port/db/:dbname/' => \&_reload_db;
+put  '/:host/:port/db/:dbname/' => \&_reload_db;
+put  '/:host/:port/db/:dbname/*.sql' => \&_run_file;
+post '/:host/:port/db/:dbname/*.sql' => \&_run_file;
+get  '/:host/:port/db/:dbname/backup/*.*' => \&_backup_db;
+put  '/:host/:port/db/:dbname/backup/*.*' => \&_restore_backup;
+post '/:host/:port/db/:dbname/backup/*.*' => \&_restore_backup;
+
+
+sub _list_dbs {
+    my $db = authenticate(
+              host   => param('host'), 
+              port   => param('port'),
+              dbname => 'postgres'
+    );
+    return $db->list_dbs;
+}
+
+sub _createdb {
+    my $db = authenticate(
+              host   => param('host'), 
+              port   => param('port'),
+              dbname => 'postgres'
+    );
+    my $newdb = App::LedgerSMB::Admin::Database->new(
+           $db->export, dbname => param('dbname')
+    );
+    $newdb->create;
+    $newdb->load;
+    return $newdb->list_dbs;
+}
+
+sub _backup_globals {
+}
+
+sub _restore_globals {
+}
+
+sub _reload_db {
+}
+
+sub _backup_db {
+}
+
+sub _restore_db {
+}
+
+sub _run_file {
+}
+
+1;

t/00-load.t

@@ -4,13 +4,15 @@ use strict;
 use warnings FATAL => 'all';
 use Test::More;
 
-plan tests => 4;
+plan tests => 6;
 
 BEGIN {
     use_ok( 'App::LedgerSMB::Admin' ) || print "Bail out!\n";
     use_ok( 'App::LedgerSMB::Admin::Database' );
     use_ok( 'App::LedgerSMB::Admin::Database::Setting' );
+    use_ok( 'App::LedgerSMB::Admin::Database::Routings' );
     use_ok( 'App::LedgerSMB::Admin::User' );
+    use_ok( 'App::LedgerSMB::Admin::Auth' );
 }
 
 diag( "Testing App::LedgerSMB::Admin $App::LedgerSMB::Admin::VERSION, Perl $], $^X" );