File Coverage

blib/lib/Linux/usermod.pm

Criterion	Covered	Total	%
statement	210	431	48.7
branch	78	244	31.9
condition	13	72	18.0
subroutine	15	26	57.6
pod	12	14	85.7
total	328	787	41.6

package Linux::usermod;

use strict;
use Carp;
use Fcntl ':flock';
use vars qw($VERSION);
$VERSION = 0.69;

our $file_passwd  = '/etc/passwd';
our $file_shadow  = '/etc/shadow';
our $file_group	  = '/etc/group';
our $file_gshadow = '/etc/gshadow';

my %field = (
	NAME     => 0,	#The user's name
	PPASSWORD=> 1,	#The "passwd" file password
	UID      => 2,	#The user's id
	GID      => 3,	#The user's group id
	COMMENT  => 4,	#The comment about the user
	HOME     => 5,	#The user's home directory
	SHELL	 => 6,	#The user's shell
	SNAME	 => 7,	#The user's name in shadow file
	PASSWORD => 8,	#The 13-character encrypted password
	LASTCHG  => 9, 	#The number of days since January 1, 1970 of the last password changed date
	MIN	 => 10, #The minimum number of days required between password changes
	MAX	 => 11,	#The maximum number of days the password is valid
	WARN	 => 12,	#The number of days before expiring the password that the user is warned
	INACTIVE => 13,	#The number of days of inactivity allowed for the user
	EXPIRE 	 => 14,	#The number of days since January 1, 1970 that account is disabled
	FLAG	 => 15	#Currently not used.
);

my %gfield = (
	NAME	 => 0, #The group name
	PPASSWORD=> 1, #The group password
	GID	 => 2, #The group id number
	USERS	 => 3, #The group members (users)
	SNAME	 => 4, #The group name in gshadow file
	PASSWORD => 5, #The encrypted ggroup password
	GA	 => 6, #The group administrators
	GU	 => 7  #The group members (users)
);

sub fields { keys %field }

sub gfields { keys %gfield }

sub new {
	my $class = shift;
	my $user  = shift;
	my $flag  = shift;
	my @args;
	if ($flag){
		croak "no such group" unless _exists($user, $flag);
		@args = _read_grp($user);
		push @args, '__G__';
	}else{
		croak "no such user" unless _exists($user, $flag);
		@args = _read_user($user);
		push @args, '__U__';
	}
	return bless [ @args ], ref($class)||$class;
}

sub get {
	my $self = shift;
	my $what = shift;
	my $key;
	if($self->[-1] eq '__U__'){
		if($what =~ /^\d{1,2}$/){
			while(my($k, $v) = each %field){
				$v == $what and $key = $k
			}
			return $self->[$field{$key}]
		}
		$what = uc $what;
		return $self->[$field{$what}]
	}
	elsif($self->[-1] eq '__G__'){
		if($what =~ /^\d{1,2}$/){
			while(my($k, $v) = each %gfield){
				$v == $what and $key = $k
			}
			return $self->[$gfield{$key}]
		}
		$what = uc $what;
		return $self->[$gfield{$what}]
	}
}

sub set {
	my $self = shift;
	my $what = shift;
	my $newval = shift;
	$what = uc $what;
	return 0 unless exists($field{$what}) or exists($gfield{$what});
	return 0 if $newval =~ /:/ and ($field{$what} != 8 or $gfield{$what} != 4);
	$newval = '' if $newval =~  /^undef$/i;
	if($self->[-1] eq '__U__'){
	 my $flag = shift || 0;
	 my $oldval = $self->[$field{$what}];
	 my $name = $self->[$field{NAME}];
	 _clean($name);
	 $self->[$field{$what}] = $newval;
	 if($field{$what} <= 6){
		my @file = _io("$file_passwd", '', 'r');
		my @user;
		push @user, $self->[$_] for 0..6;
		my $user = join ':', @user;
		for(@file){ s/.+/$user/ if /^\Q$name\E:/ }
		_io("$file_passwd", \@file, 'w');
		if($field{$what} == 0){
			croak "invalid name" if $newval !~ /^([A-Z]|[a-z]){1}\w{0,254}/;
			my %names;
			@file = @user = ();
			@file = _io("$file_shadow", '', 'r');
			map{ /^(.[^:]+):/ and $names{$1} = 1 }@file;
			croak "user name $newval already exists" if defined($names{$newval});
			undef %names;
			push @user, $self->[$_] for 8..14;
			unshift @user, $self->[0];
			$user = join ':', @user;
			for(@file){ s/.+/$user/ if /^\Q$name\E:/ }
			_io("$file_shadow", \@file, 'w') and return 1
		}

	 }
	 if($field{$what} > 6){
		my @file = _io("$file_shadow", '', 'r');
		$self->[9] = _get_1970_diff() if $field{$what} == 8;
		if($field{$what} == 8 && $newval){
			$oldval =~ /^!/ and my $lock = 1;
			$self->[8] = _gen_pass($self->[$field{$what}], $lock) unless $flag;
		}
		my @user;
		push @user, "$self->[$_]" for 7..15;
		my $user = join ':', @user;
		for(@file){ s/.+/$user/ if /^\Q$name\E:/ }
		_io("$file_shadow", \@file, 'w');
		if($field{$what} == 7){
			@file = @user = ();
			@file = _io("$file_passwd", '', 'r');
			push @user, $self->[$_] for 1..6;
			unshift @user, $self->[7];
			$user = join ':', @user;
			for(@file){ s/.+/$user/ if /^\Q$name\E:/ }
			_io("$file_passwd", \@file, 'w') and return 1
		}
	 }
	}
	elsif($self->[-1] eq '__G__'){
	 my $name = $self->[$gfield{NAME}];
	 my $oldval = $self->[$gfield{$what}];
	 $self->[$gfield{$what}] = $newval;
	 if($gfield{$what} == 0 or $gfield{$what} == 4){
		croak "invalid name" if $newval !~ /^([A-Z]|[a-z]){1}\w{0,254}/;
	 	my @file = _io($file_group, '', 'r');
		my %names;
		map{ m#^(.[^:]+):# and $names{$1} }@file;
		croak "group name $newval already exists" if exists($names{$newval});
		undef %names;
		for(@file){
			/^$oldval:/ or next;
			my $newline = "$self->[0]:$self->[1]:$self->[2]:$self->[3]";
			s/.+/$newline/;
		}
		_io($file_group, \@file, 'w');
		@file = _io($file_gshadow, '', 'r');
		for(@file){
			/^$oldval:/ or next;
			$self->[4] = $newval;
			my $newline = "$self->[4]:$self->[5]:$self->[6]:$self->[7]";
			s/.+/$newline/;
		}
		_io($file_gshadow, \@file, 'w') and return 1
	 }
	 if($gfield{$what} == 3 or $gfield{$what} == 7){
		for(split /\s+/, $newval){
			croak "$_ does not exist" unless(_exists($_))
		}
		my $users = join ',', split /\s+/, "$newval";
		$self->[3] = $users;
		my @file = _io($file_group, '', 'r');
		for(@file){
			/^\Q$name\E:/ or next;
			my $newline = "$self->[0]:$self->[1]:$self->[2]:$self->[3]";
			s/.+/$newline/;
		}
		_io($file_group, \@file, 'w');
		@file = _io($file_gshadow, '', 'r');
		$self->[7] = $users;
		for(@file){
			/^\Q$name\E:/ or next;
			my $newline = "$self->[4]:$self->[5]:$self->[6]:$self->[3]";
			s/.+/$newline/;
		}
		_io($file_gshadow, \@file, 'w') and return 1
	 }
	 if($gfield{$what} == 2){
	 	croak "wrong group id" if $newval < 1 or $newval > 65535;
		my %ids;
		my @file  = _io("$file_group", '', 'r');
		map { /^.+?:.*?:(.+):/ and $ids{$1} = 1 } @file;
		croak "group id $newval already exists" if $ids{$newval};
		for(@file){
			/^\Q$name\E:/ or next;
			my $newline = "$self->[0]:$self->[1]:$self->[2]:$self->[3]";
			s/.+/$newline/;
		}
		_io($file_group, \@file, 'w') and return 1
	 }
	 if($gfield{$what} == 6){
		croak "user $newval does not exist" unless(_exists($newval));
		$self->[6] = $newval;
		my @file = _io($file_gshadow, '', 'r');
		for(@file){
		        /^\Q$name\E:/ or next;
			my $newline = "$self->[4]:$self->[5]:$self->[6]:$self->[7]";
			s/.+/$newline/;
		}
		_io($file_gshadow, \@file, 'w') and return 1
	 }
	 if($gfield{$what} == 1 or $gfield{$what} == 5){
	 	no strict 'refs';
	 	my $salt = join '', ('a'..'z', 'A'..'Z', 0..9)[rand 26,rand 26,rand 26];
		my $newpass;
		if($newval)
			{ $newpass = crypt($newval, $salt) }
		else
			{ $newpass = '!' }
		my @file = _io($file_gshadow, '', 'r');
		$self->[1] = 'x';
		$self->[5] = $newpass;
		for(@file){
		        /^\Q$name\E:/ or next;
			my $newline = "$self->[4]:$self->[5]:$self->[6]:$self->[7]";
			s/.+/$newline/;
		}
		_io($file_gshadow, \@file, 'w');
		@file = _io($file_group, '', 'r');
		for(@file){
		        /^\Q$name\E:/ or next;
			my $newline = "$self->[0]:$self->[1]:$self->[2]:$self->[3]";
			s/.+/$newline/;
		}
		_io($file_group, \@file, 'w') and return 1
	 }
	}
	return 0
}

sub _read_user {
	my $username = shift;
	my (@user, @tmp, @file);
	@file = _io($file_passwd, '', 'r');
	for(@file){
		/^\Q$username\E:/ or next;
		my $user = $_;
		for(1..7){
			$user =~ m#(.[^:]*){$_}#;
			my $ss = $1;
			$ss =~ s/(^:*|:*$)//;
			$tmp[$_ - 1] = $ss;
		} last
	}
	@user = @tmp;
	@tmp = ();
	@file = _io($file_shadow, '', 'r');
	for(@file){
		/^\Q$username\E:/ or next;
		my $user = $_;
		for(1..9){
			$user =~ m#(.[^:]*){$_}#;
			my $ss = $1;
			$ss =~ s/(^:*|:*$)//;
			$tmp[$_ - 1] = $ss;
		} last
	}
	@user = (@user, @tmp);
	return (@user);
}

sub _gen_pass {
	my $password = shift;
	my $flag = shift;
	$password or croak "no password given";
	my @rands = ( "A" .. "Z", "a" .. "z", 0 .. 9 );
	my $salt = join("", @rands[ map { rand @rands } ( 1 .. 8 ) ]);
	$password = ($flag)?'!'.crypt($password, q($1$)."$salt"):crypt($password, q($1$)."$salt");
	return $password
}

sub _exists {
	my $name	= shift;
	my $gflag	= shift;
	my $file	= ($gflag) ? "$file_group" : "$file_passwd";
	my @file	= _io("$file", '', 'r');
	my $flag;
	/^\Q$name\E:/ and $flag = 1 for @file;
	return $flag ? 1 : 0
}

sub add {
	my $class = shift;
	my (%fields, $c, @args);
	push @args, $_ for @_;
	croak "no username given" if scalar @args == 0;
	croak "user $args[0] exists" if _exists($args[0]);
	for(@args){
		chomp($_);
		/^\s*$/ and $c++ and next;
		$c++;
		if($c == 1){
			croak "wrong username given" if /:/;
			croak "wrong username" unless /^([A-Z]|[a-z]){1}\w{0,254}/;
			$fields{username} = $_ || croak "no username given";
		}
		if($c == 2){
			croak "wrong password length" unless /^(.*){0,254}$/;
			$fields{password} = _gen_pass($_) if $_;
		}
		if($c == 3){
			$_ eq '' and $_ = 1000;
		 	croak "wrong uid" unless /^\d+$/;
			croak "wrong uid" if $_ > 65535 or $_ < 1;
			$fields{uid} = $_ || 1000;
		}
		if($c == 4){
			$_ eq '' and $_ = 1000;
			croak "wrong gid" unless /^\d+$/;
			if(/^\d+$/){ croak "wrong gid" if $_ > 65535 or $_ < 1 }
			$fields{gid} = $_ || $fields{uid};
		}
		if($c == 5){
			croak "wrong comment given" if /:/;
			$fields{comment} = $_;
		}
		if($c == 6){
			croak "wrong home given" if /:/;
			$fields{home} = $_;
		}
		if($c == 7){
			croak " wrong shell given" if /:/;
			$fields{shell} = $_;
		}
	}
	$fields{password} or $fields{password} = '!';
	my @file = _io("$file_passwd", '', 'r');
	my @ids;
	push @ids, (split /:/)[2] for @file;
	for (@ids){
		if ($fields{uid} == $_){
			$fields{uid} = 1000;
			last
		}
	}
	if($fields{uid} == 1000){
	   for(sort @ids){
		$_ < 1000 and next;
		$fields{uid} == $_ and $fields{uid}++;
	   }
	}
	$fields{gid} = $fields{uid} if !$fields{gid};
	my @newuser = ("$fields{username}:x:$fields{uid}:$fields{gid}:$fields{comment}:$fields{home}:$fields{shell}");
	_io("$file_passwd", \@newuser, 'a');
	my $time_1970 = _get_1970_diff();
	@newuser = ("$fields{username}:$fields{password}:$time_1970:0:99999:7:::");
	_io("$file_shadow", \@newuser, 'a');
	return 1
}

sub grpadd {
	my $class = shift;
	my $group = shift or croak "empty group name";
	my $gid = shift;
	my $users = shift;
	my (@tmp, %file, @newgroup);
	my @file  = _io("$file_group", '', 'r');
	croak "wrong group name" unless $group =~ /^([A-Z]|[a-z]){1}\w{0,254}/;
	map { @tmp = split /:/, $_ and $file{$tmp[0]} = $tmp[2] } @file;
	exists($file{$group}) and croak "group $group already exists";
	if(!$gid){
		$gid = 100;
		for(sort {$a <=> $b} values %file){
			next if $_ < 100;
			$gid == $_ and $gid++
		}
	}
	my $userlist = join(',', split(/\s+/, $users));
	@newgroup = ("$group:x:$gid:$userlist");
	_io("$file_group", \@newgroup, 'a');
	@newgroup = ("$group:!!::$userlist");
	_io("$file_gshadow", \@newgroup, 'a');
}

sub del {
	my $class = shift;
	my $username = shift;
	_exists($username) or croak "user $username does not exist";
	my @old = _io("$file_passwd", '', 'r');
	my @new;
	/^\Q$username\E:/ or push @new, $_ for @old;
	_io("$file_passwd", \@new, 'w');
	@new = ();
	@old = _io("$file_shadow", '', 'r');
	/^\Q$username\E:/ or push @new, $_ for @old;
	_io("$file_shadow", \@new, 'w');
	return 1
}

sub grpdel {
	my $class = shift;
	my $group = shift or croak "empty group name/gid";
	my (@tmp, %file);
	my @file  = _io("$file_group", '', 'r');
	map { @tmp = split /:/, $_ and $file{$tmp[0]} = $tmp[2] } @file;
	exists($file{$group}) or croak "group $group does not exists";
	@tmp = ();
	/^$group/ or push @tmp, $_ for @file;
	_io("$file_group", \@tmp, 'w');
	@file = _io("$file_gshadow", '', 'r');
	@tmp = ();
	/^$group/ or push @tmp, $_ for @file;
	_io("$file_gshadow", \@tmp, 'w');

}

sub _read_grp {
	my $group = shift or croak "empty group name/gid";
	my (@tmp, @grp);
	my @file  = _io("$file_group", '', 'r');
	for(@file){
		/^$group:/ or next;
		my $user = $_;
		for(1..4){
			$user =~ /(.[^:]*){$_}/;
			my $ss = $1;
			$ss =~ s/(^:*|:*$)//;
			$tmp[$_ - 1] = $ss;
		} last
	}
	@grp = @tmp;
	@file  = _io("$file_gshadow", '', 'r');
	for(@file){
		/^$group:/ or next;
		my $user = $_;
		for(1..4){
			$user =~ /(.[^:]*){$_}/;
			my $ss = $1;
			$ss =~ s/(^:*|:*$)//;
			$tmp[$_ - 1] = $ss;
		} last
	}
	@grp = (@grp, @tmp);
	return (@grp)
}

sub tobsd{
	my $self = shift;
	(my @file) = _io("$file_shadow", '', 'r');
	my $name = $self->get('name');
	my @user;
	for(@file){
		/^\Q$name\E:/ or next;
		push @user, $name, ':';
		push @user, $self->get('password'), ':';
		push @user, $self->get('uid'), ':';
		push @user, $self->get('gid'), ':';
		push @user, ':';
		push @user, $self->get('expire') || 0, ':';
		push @user, $self->get('expire') || 0, ':';
		push @user, $self->get('comment'), ':';
		push @user, $self->get('home'), ':';
		push @user, $self->get('shell');
		my $user = join '', @user;
		s/.*/$user/;
	}
	_io("$file_shadow", \@file, 'w');
	return 1
}

sub _io{
        my $file = shift;
	my $newvals = shift;
	my $flag = shift;
	my @file;
	croak $! unless -f $file;
	local *FH;
	die "posible flags: r/w/a" unless $flag =~ /^(r|w|a)$/;
	if($flag eq 'r'){
		open FH, $file or croak "can't open_r $file $!";
		flock FH, LOCK_SH or croak "can't lock_sh $file";
		@file = ;
		close FH;
		map { s/\n// } @file;
		return @file;
	}
	if($flag eq 'w'){
		open FH, "> $file" or croak "can't open_w $file $!";
		flock FH, LOCK_EX or croak "can't lock_ex $file";
		print FH "$_\n" for @{$newvals};
		close FH;
		return 1
	}
	if($flag eq 'a'){
		open FH, ">> $file" or croak "can't open_a $file $!";
		flock FH, LOCK_EX or croak "can't lock_ex $file";
		print FH "$_\n" for @{$newvals};
		close FH;
		return 1
	}
}

sub users{
	my $class = shift;
	(my @file) = _io("$file_passwd", '', 'r');
	my (%users, @users);
	m#^(.[^:]+):# and push @users, $1 for @file;
	map{ $users{$_} = 1 }@users;
	return %users
}

sub grps{
	my $class = shift;
	(my @file) = _io("$file_group", '', 'r');
	my (%users, @users);
	m#^(.[^:]+):# and push @users, $1 for @file;
	map{ $users{$_} = 1 }@users;
	return %users
}

sub lock{
	my $self = shift;
	my $password = $self->get("password");
	return 1 if $password =~ /^\!/;
	$password =~ s/(.*)/!$1/;
	$self->set("password", $password, 1);
}

sub unlock{
        my $self = shift;
	my $password = $self->get("password");
	return if $password !~ /^\!/;
	$password =~ s/^\!//;
	$password ||= 'undef';
        $self->set("password", $password, 1);
}

sub _get_1970_diff{ return int time / (3600 * 24) }

sub _clean{
	my $specchars = \shift;
	my $special = qr#\$|\*|\@|\^|\+|\.|\?|\)|\(|\||\]|\[|\{|\}#;
	$$specchars =~ s/($special)/\\$1/g;
}

1

__END__