More work on LDAP support

diff --git a/acl/acl-lib.pl b/acl/acl-lib.pl
index 7ab90e1..ed9706b 100755 (executable)
--- a/acl/acl-lib.pl
+++ b/acl/acl-lib.pl
@@ -19,6 +19,7 @@ do 'md5-lib.pl';
 $access{'switch'} = 0 if (&is_readonly_mode());
 
 # XXX LDAP support
+#      XXX schema test / creation?
 # XXX CHANGELOG / docs
 # XXX test with Virtualmin
 
@@ -1625,7 +1626,7 @@ my ($proto, $user, $pass, $host, $prefix, $args) = @_;
 return "" if (!$proto);
 my $argstr;
 if (keys %$args) {
-       $argstr = "?".map { $_."=".$args->{$_} } (keys %$args);
+       $argstr = "?".join("&", map { $_."=".$args->{$_} } (keys %$args));
        }
 return $proto."://".$user.":".$pass."\@".$host."/".$prefix.$argstr;
 }
@@ -1693,11 +1694,21 @@ elsif ($proto eq "ldap") {
        my $dbh = &connect_userdb($str);
        ref($dbh) || return $dbh;
 
+       # Check for Webmin object classes
+       my $schema = $dbh->schema();
+       my @allocs = map { $_->{'name'} }
+                       $schema->all_objectclasses();
+       &indexof($args->{'userclass'}, @allocs) >= 0 ||
+               return &text('sql_eclass', $args->{'userclass'});
+       &indexof($args->{'groupclass'}, @allocs) >= 0 ||
+               return &text('sql_eclass', $args->{'groupclass'});
+
        # Check that base DN exists
        if (!$notablecheck) {
                my $superprefix = $prefix;
                $superprefix =~ s/^[^,]+,//;    # Make parent DN
                my $rv = $dbh->search(base => $superprefix,
+                                     filter => '(objectClass=*)',
                                      scope => 'one');
                my $niceprefix = lc($prefix);
                $niceprefix =~ s/\s//g;

diff --git a/acl/lang/en b/acl/lang/en
index 92189a3..08fbf39 100644 (file)
--- a/acl/lang/en
+++ b/acl/lang/en
@@ -411,6 +411,7 @@ sql_addto1=Add new users to local files
 sql_emod=Missing required Perl module <tt>$1</tt>
 sql_etable=Failed to query required table $1 : $2
 sql_eldapdn=Base LDAP DN $1 was not found
+sql_eclass=LDAP object class $1 does not exist in the server's schema
 sql_err=Failed to save user and group database settings
 sql_ehost=Missing or un-resolvable hostname
 sql_euser=Missing or invalid username (no spaces allowed)
@@ -433,3 +434,11 @@ make_exec=Executing SQL $1 ..
 make_failed=.. creation failed : $1
 make_done=.. done
 make_still=Some problems were found even after table creation : $1
+
+makedn_title=Create LDAP DN
+makedn_eoc=No structural object classes found!
+makedn_exec=Creating parent DN $1 ..
+makedn_failed=.. creation failed : $1
+makedn_done=.. done
+makedn_still=Some problems were found even after DN creation : $1
+

diff --git a/acl/makedn.cgi b/acl/makedn.cgi
new file mode 100755 (executable)
index 0000000..4875b06
--- /dev/null
+++ b/acl/makedn.cgi
@@ -0,0 +1,62 @@
+#!/usr/local/bin/perl
+# Create the LDAP base DN
+
+require './acl-lib.pl';
+$access{'pass'} || &error($text{'sql_ecannot'});
+&get_miniserv_config(\%miniserv);
+&ReadParse();
+&error_setup($text{'makedn_err'});
+
+$dbh = &connect_userdb($in{'userdb'});
+ref($dbh) || &error($dbh);
+
+&ui_print_unbuffered_header(undef, $text{'makedn_title'}, "");
+
+# Work out object class for the DN
+($proto, $user, $pass, $host, $prefix, $argstr) =
+       &split_userdb_string($in{'userdb'});
+$schema = $dbh->schema();
+@allocs = map { $_->{'name'} }
+           grep { $_->{'structural'} }
+                $schema->all_objectclasses();
+@ocs = ( );
+foreach my $poc ("top", "domain") {
+        if (&indexof($poc, @allocs) >= 0) {
+                push(@ocs, $poc);
+                }
+        }
+@ocs || &error(&text('makedn_eoc'));
+
+# Create the DN
+print &text('makedn_exec', "<tt>$prefix</tt>"),"<br>\n";
+@attrs = ( "objectClass", \@ocs );
+if (&indexof("domain", @ocs) >= 0 && $prefix =~ /^([^=]+)=([^, ]+)/) {
+       # Domain class needs dc
+       push(@attrs, $1, $2);
+       }
+$rv = $dbh->add($prefix, attr => \@attrs);
+if (!$rv || $rv->code) {
+       print &text('makedn_failed',
+                   $rv ? $rv->error : "Unknown error"),"<p>\n";
+       }
+else {
+       print &text('makedn_done'),"<p>\n";
+       }
+&disconnect_userdb($in{'userdb'}, $dbh);
+
+# Check again if OK
+$err = &validate_userdb($in{'userdb'}, 0);
+if ($err) {
+       print "<b>",&text('makedn_still', $err),"</b><p>\n";
+       }
+else {
+       &lock_file($ENV{'MINISERV_CONFIG'});
+       $miniserv{'userdb'} = $in{'userdb'};
+       $miniserv{'userdb_addto'} = $in{'addto'};
+       &put_miniserv_config(\%miniserv);
+       &unlock_file($ENV{'MINISERV_CONFIG'});
+       &reload_miniserv();
+       }
+
+&ui_print_footer("", $text{'index_return'});
+

diff --git a/acl/maketables.cgi b/acl/maketables.cgi
index 6f3d188..33b59f6 100755 (executable)
--- a/acl/maketables.cgi
+++ b/acl/maketables.cgi
@@ -26,11 +26,6 @@ foreach $sql (&userdb_table_sql($in{'userdb'})) {
        }
 &disconnect_userdb($in{'userdb'}, $dbh);
 
-# XXX create table fails for postgresql!!
-#$dbh = &connect_userdb($in{'userdb'});
-#$cmd = $dbh->prepare("select * from webmin_user");
-#$cmd && $cmd->execute() || &error("select failed : ".$dbh->errstr);
-
 # Check again if OK
 $err = &validate_userdb($in{'userdb'}, 0);
 if ($err) {

diff --git a/acl/save_sql.cgi b/acl/save_sql.cgi
index 1d87784..c516133 100755 (executable)
--- a/acl/save_sql.cgi
+++ b/acl/save_sql.cgi
@@ -63,7 +63,7 @@ if ($err && ($p eq "mysql" || $p eq "postgresql")) {
        &ui_print_header(undef, $text{'sql_title2'}, "");
 
        print &text('sql_tableerr', $err),"<p>\n";
-       print $text{'sql_tableerr2'},"<p>\n";
+       print $text{'sql_tableerr2'},"<br>\n";
        print &ui_form_start("maketables.cgi");
        print &ui_hidden("userdb", $str);
        print &ui_hidden("userdb_addto", $in{'addto'});
@@ -83,7 +83,7 @@ elsif ($err && $p eq "ldap") {
        &ui_print_header(undef, $text{'sql_title3'}, "");
 
        print &text('sql_dnerr', $err),"<p>\n";
-       print $text{'sql_dnerr2'},"<p>\n";
+       print $text{'sql_dnerr2'},"<br>\n";
        print &ui_form_start("makedn.cgi");
        print &ui_hidden("userdb", $str);
        print &ui_hidden("userdb_addto", $in{'addto'});

diff --git a/acl/webmin.schema b/acl/webmin.schema
new file mode 100644 (file)
index 0000000..1aa89b4
--- /dev/null
+++ b/acl/webmin.schema
@@ -0,0 +1,40 @@
+# Object and attribute classes for Webmin users and groups
+#
+# OID Base is    : 1.3.6.1.4.1.9999.4  # Fix later
+# Attributes     : 1.3.6.1.4.1.9999.4.1.x
+# Object classes : 1.3.6.1.4.1.9999.4.2.x
+
+attributetype ( 1.3.6.1.4.1.9999.4.1.1 NAME 'webminName'
+       DESC 'Webmin username'
+       SYNTAX 1.3.6.1.4.1.1466.115.121.1.26{255} SINGLE-VALUE )
+
+attributetype ( 1.3.6.1.4.1.9999.4.1.2 NAME 'webminPass'
+       DESC 'Webmin password'
+       SYNTAX 1.3.6.1.4.1.1466.115.121.1.26{255} SINGLE-VALUE )
+
+attributetype ( 1.3.6.1.4.1.9999.4.1.3 NAME 'webminAttr'
+       DESC 'Webmin user attribute name=value format'
+       SYNTAX 1.3.6.1.4.1.1466.115.121.1.26{255} COLLECTIVE )
+
+attributetype ( 1.3.6.1.4.1.9999.4.1.4 NAME 'webminAcl'
+       DESC 'Webmin user ACL module=name=value format'
+       SYNTAX 1.3.6.1.4.1.1466.115.121.1.26{255} COLLECTIVE )
+
+attributetype ( 1.3.6.1.4.1.9999.4.1.5 NAME 'webminDesc'
+       DESC 'Webmin group description'
+       SYNTAX 1.3.6.1.4.1.1466.115.121.1.26{255} SINGLE-VALUE )
+
+attributetype ( 1.3.6.1.4.1.9999.4.1.6 NAME 'webminModule'
+       DESC 'Webmin module name'
+       SYNTAX 1.3.6.1.4.1.1466.115.121.1.26{255} COLLECTIVE )
+
+objectclass ( 1.3.6.1.4.1.9999.4.2.1 NAME 'webminUser' SUP top AUXILIARY
+       DESC 'Webmin user account'
+       MUST ( webminName $ webminPass )
+       MAY ( webminAttr $ webminAcl $ webminModule ))
+
+objectclass ( 1.3.6.1.4.1.9999.4.2.2 NAME 'webminGroup' SUP top AUXILIARY
+       DESC 'Webmin group account'
+       MUST ( webminName $ webminDesc )
+       MAY ( webminAttr $ webminAcl $ webminModule ))
+

diff --git a/miniserv.pl b/miniserv.pl
index c52cd30..50aca78 100755 (executable)
--- a/miniserv.pl
+++ b/miniserv.pl
@@ -4258,8 +4258,39 @@ elsif ($proto eq "postgresql") {
        return wantarray ? ($dbh, $proto) : $dbh;
        }
 elsif ($proto eq "ldap") {
-       # XXX
-       return "LDAP not done yet";
+       # Connect with perl LDAP module
+       eval "use Net::LDAP";
+       $@ && return $text{'sql_eldapdriver'};
+       my ($host, $port) = split(/:/, $host);
+       my $scheme = $args->{'scheme'} || 'ldap';
+       if (!$port) {
+               $port = $scheme eq 'ldaps' ? 636 : 389;
+               }
+       my $ldap = Net::LDAP->new($host,
+                                 port => $port,
+                                 'scheme' => $scheme);
+       $ldap || return &text('sql_eldapconnect', $host);
+       my $mesg;
+       if ($args->{'tls'}) {
+               # Switch to TLS mode
+               eval { $mesg = $ldap->start_tls(); };
+               if ($@ || !$mesg || $mesg->code) {
+                       return &text('sql_eldaptls',
+                           $@ ? $@ : $mesg ? $mesg->error : "Unknown error");
+                       }
+               }
+       # Login to the server
+       if ($pass) {
+               $mesg = $ldap->bind(dn => $user, password => $pass);
+               }
+       else {
+               $mesg = $ldap->bind(dn => $user, anonymous => 1);
+               }
+       if (!$mesg || $mesg->code) {
+               return &text('sql_eldaplogin', $user,
+                            $mesg ? $mesg->error : "Unknown error");
+               }
+       return wantarray ? ($ldap, $proto) : $ldap;
        }
 else {
        return "Unknown protocol $proto";