[pve-devel] r4965 - pve-access-control/trunk

svn-commits at proxmox.com svn-commits at proxmox.com
Tue Aug 10 15:00:32 CEST 2010


Author: dietmar
Date: 2010-08-10 13:00:32 +0000 (Tue, 10 Aug 2010)
New Revision: 4965

Modified:
   pve-access-control/trunk/AccessControl.pm
   pve-access-control/trunk/ChangeLog
   pve-access-control/trunk/control.in
   pve-access-control/trunk/pveum
Log:
	* control.in (Depends): depend on libpve-common-perl

	* AccessControl.pm: initialize Crypt::OpenSSL::RSA with
	import_random_seed(), else I get a 'Segmentation fault' when
	creating tickets ("pveum ticket <testuser>").
	
	* AccessControl.pm:  Moved utilities to new PVE::Tools
	module (pve-common), use new PVE::INotify to read/write config files.

	* AccessControl.pm (parse_domains): ignore case (always convert
	type to lower case), fix bug from Seth and test for 'ldaps'.
	(file_set_contents): use O_WRONLY|O_CREAT instead of 'w' - else
	perm gets ignored.


Modified: pve-access-control/trunk/AccessControl.pm
===================================================================
--- pve-access-control/trunk/AccessControl.pm	2010-08-10 12:19:05 UTC (rev 4964)
+++ pve-access-control/trunk/AccessControl.pm	2010-08-10 13:00:32 UTC (rev 4965)
@@ -2,17 +2,15 @@
 
 use strict;
 use Encode;
-use POSIX;
-use IO::Select;
-use IO::File;
-use IPC::Open3;
 use Crypt::OpenSSL::Random;
 use Crypt::OpenSSL::RSA;
 use MIME::Base64;
-use Fcntl ':flock';
 use Digest::SHA;
 use Authen::PAM qw(:constants);
 use Net::LDAP;
+use PVE::Tools qw(run_command lock_file file_get_contents);
+use PVE::INotify qw(read_file write_file);
+
 use Data::Dumper; # fixme: remove
 
 # $authdir must be writable by root only!
@@ -30,6 +28,23 @@
 
 my $ticket_lifetime = 3600*2; # 2 hours
 
+Crypt::OpenSSL::RSA->import_random_seed();
+ 
+PVE::INotify::register_file('authkeypub', "$authdir/authkey.pub",
+			    \&read_pubkey);
+
+PVE::INotify::register_file('authkeypriv', "$authdir/authkey.key",
+			    \&read_privkey);
+
+PVE::INotify::register_file('usercfg', $userconfigpath, 
+			    \&parse_user_config,  \&write_user_config);
+
+PVE::INotify::register_file('shadowpasswd', $shadowconfigpath, 
+			    \&parse_shadow_passwd, \&write_shadow_config, undef,
+			    perm => 0600);
+
+PVE::INotify::register_file('domaincfg', $domainconfigpath, \&parse_domains);
+
 sub auth_data_dir {
     return $authdir;
 }
@@ -39,7 +54,7 @@
 
     my $parent = ( caller(1) )[3];
 
-    lock_file($userconfiglock, $parent, $code, @param);
+    lock_file($userconfiglock, undef, $parent, $code, @param);
 }
 
 sub lock_shadow_config {
@@ -47,344 +62,29 @@
 
     my $parent = ( caller(1) )[3];
 
-    lock_file($shadowconfiglock, $parent, $code, @param);
+    lock_file($shadowconfiglock, undef, $parent, $code, @param);
 }
 
-# flock: we use one file handle per process, so lock file
-# can be called multiple times and succeeds for the same process.
-
-my $lock_handles =  {};
-
-sub lock_file {
-    my ($filename, $text, $code, @param) = @_;
-
-    my $timeout = 10;
-
-    my $res;
-
-    eval {
-
-        local $SIG{ALRM} = sub { die "got timeout\n"; };
-
-        alarm ($timeout);
-
-        if (!$lock_handles->{$$}->{$filename}) {
-            $lock_handles->{$$}->{$filename} = new IO::File (">>$filename") ||
-                die "can't open lock for $text '$filename' - $!\n";
-        }
-
-        if (!flock ($lock_handles->{$$}->{$filename}, LOCK_EX|LOCK_NB)) {
-            print STDERR "trying to aquire lock...";
-            if (!flock ($lock_handles->{$$}->{$filename}, LOCK_EX)) {
-                print STDERR " failed\n";
-                die "can't aquire lock for $text '$filename' - $!\n";
-            }
-            print STDERR " OK\n";
-        }
-        alarm (0);
-
-        $res = &$code(@param);
-    };
-
-    my $err = $@;
-
-    alarm (0);
-
-    if ($lock_handles->{$$}->{$filename}) {
-        my $fh = $lock_handles->{$$}->{$filename};
-        $lock_handles->{$$}->{$filename} = undef;
-        close ($fh);
-    }
-
-    if ($err) {
-        $@ = $err;
-        return undef;
-    }
-
-    $@ = undef;
-
-    return $res;
-}
-
-
-sub file_set_contents {
-    my ($filename, $data, $perm)  = @_;
-
-    $perm = 0644 if !defined($perm);
-
-    my $tmpname = "$filename.tmp.$$";
-
-    eval {
-	my $fh = IO::File->new($tmpname, "w", $perm);
-	die "unable to open file '$tmpname' - $!\n" if !$fh;
-	die "unable to write '$tmpname' - $!\n" unless print $fh $data;
-	die "closing file '$tmpname' failed - $!\n" unless close $fh;
-    };
-    my $err = $@;
-
-    if ($err) {
-	unlink $tmpname;
-	die $err;
-    }
-
-    if (!rename($tmpname, $filename)) {
-	my $msg = "close (rename) atomic file '$filename' failed: $!\n";
-	unlink $tmpname;
-	die $msg;	
-    }
-}
-
-sub file_get_contents {
-    my ($filename, $max) = @_;
-
-    my $fh = IO::File->new($filename, "r") ||
-	die "can't open '$filename' - $!\n";
-
-    my $content = safe_read_from($fh, $max);
-
-    close $fh;
-
-    return $content;
-}
-
-sub safe_read_from {
-    my ($fh, $max, $oneline) = @_;
-
-    $max = 32768 if !$max;
-
-    my $br = 0;
-    my $input = '';
-    my $count;
-    while ($count = sysread($fh, $input, 8192, $br)) {
-	$br += $count;
-	die "input too long - aborting\n" if $br > $max;
-	if ($oneline && $input =~ m/^(.*)\n/) {
-	    $input = $1;
-	    last;
-	}
-    } 
-    die "unable to read input - $!\n" if !defined($count);
-
-    return $input;
-}
-
-sub run_command {
-    my ($cmd, %param) = @_;
-
-    my $old_umask;
-
-    $cmd = [ $cmd ] if !ref($cmd);
-
-    my $cmdstr = join (' ', @$cmd);
-
-    my $errmsg;
-    my $laststderr;
-
-    eval {
-	my $reader = IO::File->new();
-	my $writer = IO::File->new();
-	my $error  = IO::File->new();
-
-	my $timeout;
-	my $input;
-	my $ticket;
-	my $outfunc;
-	my $errfunc;
-
-	foreach my $p (keys %param) {
-	    if ($p eq 'timeout') {
-		$timeout = $param{$p};
-	    } elsif ($p eq 'umask') {
-		umask($param{$p});
-	    } elsif ($p eq 'errmsg') {
-		$errmsg = $param{$p};
-		$errfunc = sub {
-		    print STDERR "$laststderr\n" if $laststderr;
-		    $laststderr = shift; 
-		};
-	    } elsif ($p eq 'ticket') {
-		$ticket = $param{$p};
-	    } elsif ($p eq 'input') {
-		$input = $param{$p};
-	    } elsif ($p eq 'outfunc') {
-		$outfunc = $param{$p};
-	    } elsif ($p eq 'errfunc') {
-		$errfunc = $param{$p};
-	    } else {
-		die "got unknown parameter '$p' for run_command\n";
-	    }
-	}
-
-	# try to avoid locale related issues/warnings
-	my $lang = $param{lang} || 'C'; 
- 
-	my $orig_pid = $$;
-
-	my $pid;
-	eval {
-	    local $ENV{LANG} = $lang;
-
-	    # suppress LVM warnings like: "File descriptor 3 left open";
-	    local $ENV{LVM_SUPPRESS_FD_WARNINGS} = "1";
-
-	    local $ENV{PVETICKET} = $ticket if $ticket;
-
-	    $pid = open3($writer, $reader, $error, @$cmd) || die $!;
-	};
-
-	my $err = $@;
-
-	# catch exec errors
-	if ($orig_pid != $$) {
-	    warn "ERROR: $err";
-	    POSIX::_exit (1); 
-	    kill ('KILL', $$); 
-	}
-
-	die $err if $err;
-
-	print $writer $input if defined $input;
-	close $writer;
-
-	my $select = new IO::Select;
-	$select->add($reader);
-	$select->add($error);
-
-	my $outlog = '';
-	my $errlog = '';
-
-	while ($select->count) {
-	    my @handles = $select->can_read($timeout);
-
-	    if (defined ($timeout) && (scalar (@handles) == 0)) {
-		kill (9, $pid);
-		waitpid ($pid, 0);
-		die "timeout\n";
-	    }
-
-	    foreach my $h (@handles) {
-		my $buf = '';
-		my $count = sysread ($h, $buf, 4096);
-		if (!defined ($count)) {
-		    my $err = $!;
-		    kill (9, $pid);
-		    waitpid ($pid, 0);
-		    die $err;
-		}
-		$select->remove ($h) if !$count;
-		if ($h eq $reader) {
-		    if ($outfunc) {
-			eval {
-			    $outlog .= $buf;
-			    while ($outlog =~ s/^([^\010\r\n]*)(\r|\n|(\010)+|\r\n)//s) {
-				my $line = $1;
-				&$outfunc($line);
-			    }
-			};
-			my $err = $@;
-			if ($err) {
-			    kill (9, $pid);
-			    waitpid ($pid, 0);
-			    die $err;
-			}
-		    } else {
-			print $buf;
-			*STDOUT->flush();
-		    }
-		} elsif ($h eq $error) {
-		    if ($errfunc) {
-			eval {
-			    $errlog .= $buf;
-			    while ($errlog =~ s/^([^\010\r\n]*)(\r|\n|(\010)+|\r\n)//s) {
-				my $line = $1;
-				&$errfunc($line);
-			    }
-			};
-			my $err = $@;
-			if ($err) {
-			    kill (9, $pid);
-			    waitpid ($pid, 0);
-			    die $err;
-			}
-		    } else {
-			print STDERR $buf;
-			*STDERR->flush();
-		    }
-		}
-	    }
-	}
-
-	&$outfunc($outlog) if $outfunc && $outlog;
-	&$errfunc($errlog) if $errfunc && $errlog;
-
-	waitpid ($pid, 0);
-  
-	if ($? == -1) {
-	    die "failed to execute\n";
-	} elsif (my $sig = ($? & 127)) {
-	    die "got signal $sig\n";
-	} elsif (my $ec = ($? >> 8)) {
-	    die "$laststderr\n" if ($errmsg && $laststderr);
-	    die "exit code $ec\n";
-	}
-
-	print STDERR "$laststderr\n" if $laststderr;
-
-    };
-
-    my $err = $@;
-
-    umask ($old_umask) if defined($old_umask);
-
-    if ($err) {
-	if ($errmsg) {
-	    die "$errmsg: $err";
-	} else {
-	    die "command '$cmdstr' failed: $err";
-	}
-    }
-}
-
 sub read_pubkey {
+    my ($filename, $fh) = @_;
     
-    my $input = file_get_contents("$authdir/authkey.pub");
+    my $input = PVE::Tools::safe_read_from($fh); 
 
     return Crypt::OpenSSL::RSA->new_public_key($input);
 }
 
-my $rsa_pub_cache;
-sub rsa_pubkey {
-
-    if (!$rsa_pub_cache) {
-	$rsa_pub_cache = read_pubkey();
-	die "unable to read RSA auth key\n" if !$rsa_pub_cache;
-    }
-
-    return $rsa_pub_cache;
-}
-
 sub read_privkey {
+    my ($filename, $fh) = @_;
 
-    my $input = file_get_contents("$authdir/authkey.key");
+    my $input = PVE::Tools::safe_read_from($fh); 
 
     return Crypt::OpenSSL::RSA->new_private_key($input);
 }
 
-my $rsa_priv_cache;
-sub rsa_privkey {
-
-    if (!$rsa_priv_cache) {
-	$rsa_priv_cache = read_privkey();
-	die "unable to read private RSA auth key\n" if !$rsa_priv_cache;
-    }
-
-    return $rsa_priv_cache;
-}
-
 sub assemble_ticket {
     my ($username) = @_;
 
-    my $rsa_priv = rsa_privkey();
+    my $rsa_priv = read_file('authkeypriv');
 
     my $timestamp = time();
 
@@ -398,7 +98,7 @@
 sub verify_ticket {
     my ($ticket, $noerr) = @_;
 
-    my $rsa_pub = rsa_pubkey();
+    my $rsa_pub = read_file('authkeypub');
 
     if ($ticket && $ticket =~ m/^(\S+)::([^:\s]+)$/) {
 	my $plain = $1;
@@ -427,7 +127,7 @@
 
     die "no password\n" if !$password;
 
-    my $shadow_cfg = load_shadow_config();
+    my $shadow_cfg = read_file($shadowconfigpath);
     
     if ($shadow_cfg->{users}->{$username}) {
 	my $encpw = crypt($password, $shadow_cfg->{users}->{$username}->{shadow});
@@ -523,7 +223,7 @@
 
     my ($username, $password) = @_;
  
-    my $domain_cfg = load_domains_config();
+    my $domain_cfg = read_file($domainconfigpath);
 
     my (undef, $user, $domain) = verify_username($username);
 
@@ -615,7 +315,7 @@
 
 	($username, $user, $domain) = verify_username($username);
  
-	my $usercfg = load_user_config();
+	my $usercfg = read_file($userconfigpath);
 
 	die "no such user ('$username')\n" if !user_enabled($usercfg, $username);
 
@@ -647,7 +347,7 @@
 
 	($username, undef, $domain) = verify_username($username);
 	
-	my $usercfg = load_user_config();
+	my $usercfg = read_file($userconfigpath);
 
 	if ($opts->{create}) {
 
@@ -696,7 +396,7 @@
 	    comment_user($username, $usercfg) if $opts->{comment};
 	}
 
-	save_user_config($usercfg);
+	write_file($userconfigpath, $usercfg);
     });
 
     my $err = $@;
@@ -713,14 +413,15 @@
 
 	($username, undef, $domain) = verify_username($username);
 
-	my $usercfg = load_user_config();
+	my $usercfg =  read_file($userconfigpath);
 
 	delete ($usercfg->{users}->{$username})
 	    if $usercfg->{users}->{$username};
 	delete_shadow_password($username) if !$domain;
 	delete_user_group($username, $usercfg);
 	delete_user_acl($username, $usercfg);
-	save_user_config($usercfg);
+
+	write_file($userconfigpath, $usercfg);
     });
 
     my $err = $@;
@@ -732,10 +433,10 @@
 
     my ($username) = @_;
     lock_shadow_config(sub {
-	my $shadow_cfg = load_shadow_config();
+	my $shadow_cfg = read_file($shadowconfigpath);
 	delete ($shadow_cfg->{users}->{$username})
 	    if $shadow_cfg->{users}->{$username};
-	save_shadow_config($shadow_cfg);
+	write_file($shadowconfigpath, $shadow_cfg);
     });
     die $@ if $@;
 }
@@ -744,9 +445,9 @@
 
     my ($username,$password) = @_;
     lock_shadow_config(sub {
-	my $shadow_cfg = load_shadow_config();
+	my $shadow_cfg = read_file($shadowconfigpath);
 	$shadow_cfg->{users}->{$username}->{shadow} = encrypt_pw($password);
-	save_shadow_config($shadow_cfg);
+	write_file($shadowconfigpath, $shadow_cfg);
     });
     die $@ if $@;
 }
@@ -822,7 +523,7 @@
 
     lock_user_config(sub {
     
-	my $usercfg = load_user_config();
+	my $usercfg = read_file($userconfigpath);
 
 	verify_groupname($group);
 	
@@ -831,8 +532,7 @@
 
 	$usercfg->{groups}->{$group} = {};
 
-	save_user_config($usercfg);
-    
+	write_file($userconfigpath, $usercfg);
     });
 
     my $err = $@;
@@ -848,13 +548,12 @@
 
 	verify_groupname($group);
 
-	my $usercfg = load_user_config();
+	my $usercfg = read_file($userconfigpath);
 
 	delete ($usercfg->{groups}->{$group})
 	    if $usercfg->{groups}->{$group};
 
-	save_user_config($usercfg);
-
+	write_file($userconfigpath, $usercfg);
     });
 
     my $err = $@;
@@ -868,7 +567,7 @@
 
     lock_user_config(sub {
 
-	my $cfg = load_user_config();
+	my $cfg = read_file($userconfigpath);
 	my $propagate = $opts->{propagate} ? 1 : 0;
 	if (my $path = normalize_path($pathtxt)) {
 	    foreach my $role (split_list($rolelist)) {
@@ -907,7 +606,8 @@
 	} else {
 	    warn "user config - ignore invalid path in acl '$pathtxt'\n";
 	}
-	save_user_config($cfg);
+
+	write_file($userconfigpath, $cfg);
     });
 
     my $err = $@;
@@ -966,7 +666,7 @@
 
     lock_user_config(sub {
 	
-	my $usercfg = load_user_config();
+	my $usercfg = read_file($userconfigpath);
 
 	verify_rolename($role);
 
@@ -988,7 +688,7 @@
 	    }	
 	}
 
-	save_user_config($usercfg);
+	write_file($userconfigpath, $usercfg);
     });
 
     my $err = $@;
@@ -1002,15 +702,14 @@
 
     lock_user_config(sub {
 
-	my $usercfg = load_user_config();
+	my $usercfg = read_file($userconfigpath);
 
 	verify_rolename($role);
 
 	delete ($usercfg->{roles}->{$role})
 	    if $usercfg->{roles}->{$role};
 
-	save_user_config($usercfg);
-
+	write_file($userconfigpath, $usercfg);
     });
 
     my $err = $@;
@@ -1098,7 +797,7 @@
     $cfg->{groups}->{root}->{root} = 1;
 }
 
-sub parse_config {
+sub parse_user_config {
     my ($filename, $fh) = @_;
 
     my $cfg = {};
@@ -1236,7 +935,7 @@
     return $cfg;
 }
 
-sub parse_shadow {
+sub parse_shadow_passwd {
     my ($filename, $fh) = @_;
 
     my $shadow = {};
@@ -1350,77 +1049,33 @@
     return $domainname;
 }
 
-my $user_config_cache;
-sub load_user_config {
-    my ($reload) = @_;
+sub safe_print {
+    my ($filename, $fh, $data) = @_;
 
-    return $user_config_cache if !$reload && defined($user_config_cache);
+    return if !$data;
 
-    my $cfg = {};
+    my $res = print $fh $data;
 
-    my $fh = IO::File->new ($userconfigpath, 'r');
-    $cfg = parse_config($userconfigpath, $fh);
-    $fh->close() if $fh;
-
-    $user_config_cache = $cfg;
-
-    return $user_config_cache;
+    die "write to '$filename' failed\n" if !$res;
 }
 
-my $shadow_config_cache;
-sub load_shadow_config {
-    my ($reload) = @_;
+sub write_shadow_config {
+    my ($filename, $fh, $cfg) = @_;
 
-    return $shadow_config_cache if !$reload && defined($shadow_config_cache);
-
-    my $cfg = {};
-
-    my $fh = IO::File->new ($shadowconfigpath, 'r');
-    $cfg = parse_shadow($shadowconfigpath, $fh);
-    $fh->close() if $fh;
-
-    $shadow_config_cache = $cfg;
-
-    return $shadow_config_cache;
-}
-
-my $domains_config_cache;
-sub load_domains_config {
-    my ($reload) = @_;
-
-    return $domains_config_cache if !$reload && $domains_config_cache;
-
-    my $cfg = [];
-
-    my $fh = IO::File->new ($domainconfigpath, 'r');
-    $cfg = parse_domains($domainconfigpath, $fh);
-    $fh->close() if $fh;
-
-    $domains_config_cache = $cfg;
-
-    return $domains_config_cache;
-}
-
-sub save_shadow_config {
-    my ($cfg) = @_;
-
-    $user_config_cache = undef; # force reload
-
     my $data = '';
-
     foreach my $user (keys %{$cfg->{users}}) {
 	my $crypt_pass = $cfg->{users}->{$user}->{shadow};
 	$data .= "$user:$crypt_pass:\n";
     }
 
-    file_set_contents($shadowconfigpath, $data, 0600);
+    safe_print($filename, $fh, $data);
+
+    return $cfg;
 }
 
-sub save_user_config {
-    my ($cfg) = @_;
+sub write_user_config {
+    my ($filename, $fh, $cfg) = @_;
 
-    $user_config_cache = undef; # force reload
-
     my $data = '';
 
     foreach my $user (keys %{$cfg->{users}}) {
@@ -1504,7 +1159,9 @@
 	}
     }
     
-    file_set_contents($userconfigpath, $data, 0644);
+    safe_print($filename, $fh, $data);
+
+    return $cfg;
 }
 
 sub roles {

Modified: pve-access-control/trunk/ChangeLog
===================================================================
--- pve-access-control/trunk/ChangeLog	2010-08-10 12:19:05 UTC (rev 4964)
+++ pve-access-control/trunk/ChangeLog	2010-08-10 13:00:32 UTC (rev 4965)
@@ -1,7 +1,18 @@
 2010-08-10  Proxmox Support Team  <support at proxmox.com>
 
+	* control.in (Depends): depend on libpve-common-perl
+
+	* AccessControl.pm: initialize Crypt::OpenSSL::RSA with
+	import_random_seed(), else I get a 'Segmentation fault' when
+	creating tickets ("pveum ticket <testuser>").
+	
+	* AccessControl.pm:  Moved utilities to new PVE::Tools
+	module (pve-common), use new PVE::INotify to read/write config files.
+
 	* AccessControl.pm (parse_domains): ignore case (always convert
 	type to lower case), fix bug from Seth and test for 'ldaps'.
+	(file_set_contents): use O_WRONLY|O_CREAT instead of 'w' - else
+	perm gets ignored.
 
 2010-08-09  Seth Lauzon <seth.lauzon at gmail.com>
 

Modified: pve-access-control/trunk/control.in
===================================================================
--- pve-access-control/trunk/control.in	2010-08-10 12:19:05 UTC (rev 4964)
+++ pve-access-control/trunk/control.in	2010-08-10 13:00:32 UTC (rev 4965)
@@ -3,7 +3,7 @@
 Section: perl
 Priority: optional
 Architecture: @@ARCH@@
-Depends: libc6 (>= 2.3), perl (>= 5.6.0-16), libcrypt-openssl-rsa-perl, libcrypt-openssl-random-perl, libjson-xs-perl, libjson-perl, libterm-readline-gnu-perl,libnet-ldap-perl
+Depends: libc6 (>= 2.3), perl (>= 5.6.0-16), libcrypt-openssl-rsa-perl, libcrypt-openssl-random-perl, libjson-xs-perl, libjson-perl, libterm-readline-gnu-perl,libnet-ldap-perl, libpve-common-perl
 Maintainer: Proxmox Support Team <support at proxmox.com>
 Description: Proxmox VE access control library
  This package contains the role based user management and access

Modified: pve-access-control/trunk/pveum
===================================================================
--- pve-access-control/trunk/pveum	2010-08-10 12:19:05 UTC (rev 4964)
+++ pve-access-control/trunk/pveum	2010-08-10 13:00:32 UTC (rev 4965)
@@ -7,6 +7,7 @@
 use Term::ReadLine;
 use Data::Dumper; # fixme: remove
 use Time::HiRes qw( usleep ualarm gettimeofday tv_interval ); # fixme: remove
+use PVE::INotify;
 
 $ENV{'PATH'} = '/sbin:/bin:/usr/sbin:/usr/bin';
 
@@ -27,6 +28,8 @@
     PVE::AccessControl::run_command($cmd, umask => 0133)
 }
 
+PVE::INotify::inotify_init();
+
 sub print_usage {
     my $msg = shift;
 
@@ -50,7 +53,7 @@
     $attribs->{redisplay_function} = $attribs->{shadow_redisplay};
     my $input = $term->readline('Enter new password: ');
     my $conf = $term->readline('Retype new password: ');
-    die "Passwords do not match." if ($input ne $conf);
+    die "Passwords do not match.\n" if ($input ne $conf);
     return $input;
 }
 



More information about the pve-devel mailing list