samba-lib.pl

Unix下基于Web的管理工具

# samba-lib.pl
# Common functions for editing the samba config file

do '../web-lib.pl';
&init_config();

# Get the samba version
if (open(VERSION, "$module_config_directory/version")) {
	chop($samba_version = <VERSION>);
	close(VERSION);
	}

# list_shares()
# List all the shares from the samba config file
sub list_shares
{
local(@rv, $_);
open(SAMBA, $config{smb_conf});
while(<SAMBA>) {
	chop; s/;.*$//g; s/^\s*#.*$//g;
	if (/^\s*\[([^\]]+)\]/) {
		push(@rv, $1);
		}
	}
close(SAMBA);
return @rv;
}


# get_share(share, [array])
# Fills the associative array %share with the parameters from the given share
sub get_share
{
local($found, $_, $first, $arr);
$arr = (@_==2 ? $_[1] : "share");
undef(%$arr);
open(SAMBA, $config{smb_conf});
while(<SAMBA>) {
	chop; s/;.*$//g; s/^\s*#.*$//g;
	if (/^\s*\[([^\]]+)\]/) {
		# Start of share section
		$first = 1;
		if ($found) { last; }
		elsif ($1 eq $_[0]) { $found = 1; $$arr{share_name} = $1; }
		}
	elsif ($found && /^\s*([^=]*\S)\s*=\s*(.*)$/) {
		# Directives inside a section
		if (lc($1) eq "read only") {
			# bastard special case.. change to writable
			$$arr{'writable'} = $2 =~ /yes|true|1/i ? "no" : "yes";
			}
		else { $$arr{lc($1)} = $2; }
		}
	elsif (!$first && /^\s*([^=]*\S)\s*=\s*(.*)$/ && $_[0] eq "global") {
		# Directives outside a section! Assume to be part of [global]
		$$arr{share_name} = "global";
		$$arr{lc($1)} = $2;
		$found = 1;
		}
	}
close(SAMBA);
return $found;
}


# create_share(name)
# Add an entry to the config file
sub create_share
{
open(CONF, ">> $config{smb_conf}");
print CONF "\n";
print CONF "[$_[0]]\n";
foreach $k (grep {!/share_name/} (keys %share)) {
	print CONF "\t$k = $share{$k}\n";
	}
close(CONF);
}


# modify_share(oldname, newname)
# Change a share (and maybe it's name)
sub modify_share
{
local($_, @conf, $replacing, $first);
open(CONF, $config{smb_conf});
@conf = <CONF>;
close(CONF);
open(CONF, "> $config{smb_conf}");
for($i=0; $i<@conf; $i++) {
	chop($_ = $conf[$i]); s/;.*$//g;
	if (/^\s*\[([^\]]+)\]/) {
		$first = 1;
		if ($replacing) { $replacing = 0; }
		elsif ($1 eq $_[0]) {
			print CONF "[$_[1]]\n";
			foreach $k (grep {!/share_name/} (keys %share)) {
				print CONF "\t$k = $share{$k}\n";
				}
			print CONF "\n";
			$replacing = 1;
			}
		}
	elsif (!$first && /^\s*([^=]*\S)\s*=\s*(.*)$/ && $_[0] eq "global") {
		# found start of directives outside any share - assume [global]
		$first = 1;
		print CONF "[$_[1]]\n";
		foreach $k (grep {!/share_name/} (keys %share)) {
			print CONF "\t$k = $share{$k}\n";
			}
		print CONF "\n";
		$replacing = 1;
		}
	if (!$replacing) { print CONF $conf[$i]; }
	}
close(CONF);
}


# delete_share(share)
# Delete some share from the config file
sub delete_share
{
local($_, @conf, $deleting);
open(CONF, $config{smb_conf});
@conf = <CONF>;
close(CONF);
open(CONF, "> $config{smb_conf}");
for($i=0; $i<@conf; $i++) {
	chop($_ = $conf[$i]); s/;.*$//g;
	if (/^\s*\[([^\]]+)\]/) {
		if ($deleting) { $deleting = 0; }
		elsif ($1 eq $_[0]) {
			print CONF "\n";
			$deleting = 1;
			}
		}
	if (!$deleting) { print CONF $conf[$i]; }
	}
close(CONF);
}


# list_connections([share])
# Uses the smbstatus program to return a list of connections a share. Each
# element of the returned list is of the form:
#  share, user, group, pid, hostname, date/time
sub list_connections
{
local($l, $started, @rv);
foreach $l (split(/\n/ , `$config{samba_status_program}`)) {
	if ($l =~ /^----/) { $started = 1; }
	if ($started && $l =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)\s+\(\S+\)\s+(.*)$/ && (!$_[0] || $1 eq $_[0] || $1 eq $2 && $_[0] eq "homes")) {
		push(@rv, [ $1, $2, $3, $4, $5, $6 ]);
		}
	}
return @rv;
}


# istrue(key)
# Checks if the value of this key (or it's synonyms) in %share is true
sub istrue
{
return &getval($_[0]) =~ /yes|true|1/i;
}


# isfalse(key)
# Checks if the value of this key (or it's synonyms) in %share is false
sub isfalse
{
return &getval($_[0]) =~ /no|false|0/i;
}


# getval(name)
# Given the name of a key in %share, return the value. Also looks for synonyms.
# If the value is not found, a default is looked for.. this can come from
# a copied section, the [global] configuration section, or from the SAMBA
# defaults. This means that getval() always returns something..
sub getval
{
local($_, $copy);
if ($synon{$_[0]}) {
	foreach (split(/,/, $synon{$_[0]})) {
		if (defined($share{$_})) { return $share{$_}; }
		}
	}
if (defined($share{$_[0]})) {
	return $share{$_[0]};
	}
elsif ($_[0] ne "copy" && ($copy = $share{"copy"})) {
	# this share is a copy.. get the value from the source
	local(%share);
	&get_share($copy);
	return &getval($_[0]);
	}
else {
	# return the default value...
	return &default_value($_[0]);
	}
return undef;
}


# setval(name, value, [default])
# Sets some value in %share. Synonyms with the same meaning are removed.
# If the value is the same as the share or given default, dont store it
sub setval
{
local($_);
if (@_ == 3) {
	# default was given..
	$def = $_[2];
	}
elsif ($_[0] ne "copy" && ($copy = $share{"copy"})) {
	# get value from copy source..
	local(%share);
	&get_share($copy);
	$def = &getval($_[0]);
	}
else {
	# get global/samba default
	$def = &default_value($_[0]);
	}
if ($_[1] eq $def || ($def !~ /\S/ && $_[1] !~ /\S/) ||
    ($def =~ /^(true|yes|1)$/i && $_[1] =~ /^(true|yes|1)$/i) ||
    ($def =~ /^(false|no|0)$/i && $_[1] =~ /^(false|no|0)$/i)) {
	# The value is the default.. delete this entry
	&delval($_[0]);
	}
else {
	if ($synon{$_[0]}) {
		foreach (split(/,/, $synon{$_[0]})) {
			delete($share{$_});
			}
		}
	$share{$_[0]} = $_[1];
	}
}


# delval(name)
# Delete a value from %share (and it's synonyms)
sub delval
{
local($_);
if ($synon{$_[0]}) {
	foreach (split(/,/, $synon{$_[0]})) {
		delete($share{$_});
		}
	}
else { delete($share{$_[0]}); }
}


# default_value(name)
# Returns the default value for a parameter
sub default_value
{
local($_, %global);

# First look in the [global] section.. (unless this _is_ the global section)
if ($share{share_name} ne "global") {
	&get_share("global", "global");
	if ($synon{$_[0]}) {
		foreach (split(/,/, $synon{$_[0]})) {
			if (defined($global{$_})) { return $global{$_}; }
			}
		}
	if (defined($global{$_[0]})) { return $global{$_[0]}; }
	}

# Else look in the samba defaults
if ($synon{$_[0]}) {
	foreach (split(/,/, $synon{$_[0]})) {
		if (exists($default_values{$_})) {
			return $default_values{$_};
			}
		}
	}
return $default_values{$_[0]};
}


# The list of synonyms used by samba for parameter names
@synon = (	"writable,write ok,writeable",
		"public,guest ok",
		"printable,print ok",
		"allow hosts,hosts allow",
		"deny hosts,hosts deny",
		"create mode,create mask",
		"directory mode,directory mask",
		"path,directory",
		"exec,preexec",
		"group,force group",
		"only guest,guest only",
		"user,username,users",
		"default,default service",
		"auto services,preload",
		"lock directory,lock dir",
		"max xmit,max packet",
		"root directory,root dir,root",
		"case sensitive,case sig names"
	 );
foreach $s (@synon) {
	foreach $ss (split(/,/ , $s)) {
		$synon{$ss} = $s;
		}
	}


# Default values for samba configuration parameters
%default_values = (	"allow hosts",undef,
			"alternate permissions","no",
			"available","yes",
			"browseable","yes",
			"comment",undef,
			"create mode","755",
			"directory mode","755",
			"default case","lower",
			"case sensitive","no",
			"mangle case","no",
			"preserve case","no",
			"short preserve case","no",
			"delete readonly","no",
			"deny hosts",undef,
			"dont descend",undef,
			"force group",undef,
			"force user",undef,
			"force create mode","000",
			"force directory mode","000",
			"guest account","nobody",	# depends
			"guest only","no",
			"hide dot files","yes",
			"invalid users",undef,
			"locking","yes",
			"lppause command",undef,	# depends
			"lpq command",undef,		# depends
			"lpresume command",undef,	# depends
			"lprm command",undef,		#depends
			"magic output",undef,		# odd..
			"magic script",undef,
			"mangled map",undef,
			"mangled names","yes",
			"mangling char","~",
			"map archive","yes",
			"map system","no",
			"map hidden","no",
			"max connections",0,
			"only user","no",
			"fake oplocks","no",
			"min print space",0,
			"path",undef,
			"postscript","no",
			"preexec",undef,
			"print command",undef,
#			"print command","lpr -r -P %p %s",
			"printer",undef,
			"printer driver",undef,
			"public","no",
			"read list",undef,
			"revalidate","no",
			"root preexec",undef,
			"root postexec",undef,
			"set directory","no",
			"share modes","yes",
			"strict locking","no",
			"sync always","no",
			"user",undef,
			"valid chars",undef,
			"volume",undef,		# depends
			"wide links","yes",
			"wins support","no",
			"writable","no",
			"write list",undef );

# user_list(list)
# Convert a samba unix user list into a more readable form
sub user_list
{
local($u, @rv);
foreach $u (split(/[ \t,]+/ , $_[0])) {
	if ($u =~ /^\@(.*)$/) { push(@rv, "group <tt>$1</tt>"); }
	else { push(@rv, "<tt>$u</tt>"); }
	}
return join("," , @rv);
}


# yesno_input(name)
# Returns HTML for a true/false option
sub yesno_input
{
($n = $_[0]) =~ s/ /_/g;
return sprintf "<input type=radio name=$n value=yes %s> Yes\n".
	       "<input type=radio name=$n value=no %s> No\n",
		&istrue($_[0]) ? "checked" : "",
		&isfalse($_[0]) ? "checked" : "";
}

# username_input(name)
# Outputs HTML for an username field
sub username_input
{
($n = $_[0]) =~ s/ /_/g;
$v = &getval($_[0]);
print "<td><input name=$n size=8 value=\"$v\"> ",
	&user_chooser_button($n, 0),"</td>\n";
}

# username_input(name, default)
sub groupname_input
{
($n = $_[0]) =~ s/ /_/g;
$v = &getval($_[0]);
print "<td><input name=$n size=8 value=\"$v\"> ",
	&group_chooser_button($n, 0),"</td>\n";
}



@sock_opts = ("SO_KEEPALIVE", "SO_REUSEADDR", "SO_BROADCAST", "TCP_NODELAY", 
	      "IPTOS_LOWDELAY", "IPTOS_THROUGHPUT", "SO_SNDBUF*", "SO_RCVBUF*",
	      "SO_SNDLOWAT*", "SO_RCVLOWAT*");

@protocols = ("CORE", "COREPLUS", "LANMAN1", "LANMAN2", "NT1");


# list_users()
# Returns an array of all the users from the samba password file
sub list_users
{
local(@rv, @b, $_, $lnum);
open(PASS, $config{'smb_passwd'});
while(<PASS>) {
	$lnum++;
	chop;
	s/#.*$//g;
	local @b = split(/:/, $_);
	next if (@b < 4);
	local $u = { 'name' => $b[0],  'uid' => $b[1],
		     'pass1' => $b[2], 'pass2' => $b[3] };
	if ($samba_version >= 2 && $b[4] =~ /^\[/) {
		$b[4] =~ s/[\[\] ]//g;
		$u->{'opts'} = [ split(//, $b[4]) ];
		$u->{'change'} = $b[5];
		}
	else {
		$u->{'real'} = $b[4];
		$u->{'home'} = $b[5];
		$u->{'shell'} = $b[6];
		}
	$u->{'index'} = scalar(@rv);
	$u->{'line'} = $lnum-1;
	push(@rv, $u);
	}
close(PASS);
return @rv;
}

# create_user(&user)
# Add a user to the samba password file
sub create_user
{
open(PASS, ">>$config{'smb_passwd'}");
print PASS &user_string($_[0]);
close(PASS);
chown(0, 0, $config{'smb_passwd'});
chmod(0600, $config{'smb_passwd'});
}

# modify_user(&user)
# Change an existing samba user
sub modify_user
{
&replace_file_line($config{'smb_passwd'}, $_[0]->{'line'}, &user_string($_[0]));
}

# delete_user(&user)
# Delete a samba user
sub delete_user
{
&replace_file_line($config{'smb_passwd'}, $_[0]->{'line'});
}

sub user_string
{
local @u = ($_[0]->{'name'}, $_[0]->{'uid'},
	    $_[0]->{'pass1'}, $_[0]->{'pass2'});
if ($_[0]->{'opts'}) {
	push(@u, sprintf "[%-11s]", join("", @{$_[0]->{'opts'}}));
	push(@u, sprintf "LCT-%X", time());
	}
else {
	push(@u, $_[0]->{'real'}, $_[0]->{'home'}, $_[0]->{'shell'});
	}
return join(":", @u),"\n";
}

# set_password(user, password)
# Changes the password of a user in the encrypted password file
sub set_password
{
local($out);
$out = `$config{samba_password_program} $_[0] $_[1] 2>&1 </dev/null`;
return $out =~ /changed/;
}

1;