[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