samba/samba-lib.pl.bak

   1 # samba-lib.pl
   2 # Common functions for editing the samba config file
   3
   4 do '../web-lib.pl';
   5 &init_config();
   6
   7 # Get the samba version
   8 if (open(VERSION, "$module_config_directory/version")) {
   9         chop($samba_version = <VERSION>);
  10         close(VERSION);
  11         }
  12
  13 # list_shares()
  14 # List all the shares from the samba config file
  15 sub list_shares
  16 {
  17 local(@rv, $_);
  18 open(SAMBA, $config{smb_conf});
  19 while(<SAMBA>) {
  20         chop; s/;.*$//g; s/^\s*#.*$//g;
  21         if (/^\s*\[([^\]]+)\]/) {
  22                 push(@rv, $1);
  23                 }
  24         }
  25 close(SAMBA);
  26 return @rv;
  27 }
  28
  29
  30 # get_share(share, [array])
  31 # Fills the associative array %share with the parameters from the given share
  32 sub get_share
  33 {
  34 local($found, $_, $first, $arr);
  35 $arr = (@_==2 ? $_[1] : "share");
  36 undef(%$arr);
  37 open(SAMBA, $config{smb_conf});
  38 while(<SAMBA>) {
  39         chop; s/^\s*;.*$//g; s/^\s*#.*$//g;
  40         if (/^\s*\[([^\]]+)\]/) {
  41                 # Start of share section
  42                 $first = 1;
  43                 if ($found) { last; }
  44                 elsif ($1 eq $_[0]) { $found = 1; $$arr{share_name} = $1; }
  45                 }
  46         elsif ($found && /^\s*([^=]*\S)\s*=\s*(.*)$/) {
  47                 # Directives inside a section
  48                 if (lc($1) eq "read only") {
  49                         # bastard special case.. change to writable
  50                         $$arr{'writable'} = $2 =~ /yes|true|1/i ? "no" : "yes";
  51                         }
  52                 else { $$arr{lc($1)} = $2; }
  53                 }
  54         elsif (!$first && /^\s*([^=]*\S)\s*=\s*(.*)$/ && $_[0] eq "global") {
  55                 # Directives outside a section! Assume to be part of [global]
  56                 $$arr{share_name} = "global";
  57                 $$arr{lc($1)} = $2;
  58                 $found = 1;
  59                 }
  60         }
  61 close(SAMBA);
  62 return $found;
  63 }
  64
  65
  66 # create_share(name)
  67 # Add an entry to the config file
  68 sub create_share
  69 {
  70 open(CONF, ">> $config{smb_conf}");
  71 print CONF "\n";
  72 print CONF "[$_[0]]\n";
  73 foreach $k (grep {!/share_name/} (keys %share)) {
  74         print CONF "\t$k = $share{$k}\n";
  75         }
  76 close(CONF);
  77 }
  78
  79
  80 # modify_share(oldname, newname)
  81 # Change a share (and maybe it's name)
  82 sub modify_share
  83 {
  84 local($_, @conf, $replacing, $first);
  85 open(CONF, $config{smb_conf});
  86 @conf = <CONF>;
  87 close(CONF);
  88 open(CONF, "> $config{smb_conf}");
  89 for($i=0; $i<@conf; $i++) {
  90         chop($_ = $conf[$i]); s/;.*$//g; s/#.*$//g;
  91         if (/^\s*\[([^\]]+)\]/) {
  92                 $first = 1;
  93                 if ($replacing) { $replacing = 0; }
  94                 elsif ($1 eq $_[0]) {
  95                         print CONF "[$_[1]]\n";
  96                         foreach $k (grep {!/share_name/} (keys %share)) {
  97                                 print CONF "\t$k = $share{$k}\n";
  98                                 }
  99                         print CONF "\n";
 100                         $replacing = 1;
 101                         }
 102                 }
 103         elsif (!$first && /^\s*([^=]*\S)\s*=\s*(.*)$/ && $_[0] eq "global") {
 104                 # found start of directives outside any share - assume [global]
 105                 $first = 1;
 106                 print CONF "[$_[1]]\n";
 107                 foreach $k (grep {!/share_name/} (keys %share)) {
 108                         print CONF "\t$k = $share{$k}\n";
 109                         }
 110                 print CONF "\n";
 111                 $replacing = 1;
 112                 }
 113         if (!$replacing) { print CONF $conf[$i]; }
 114         }
 115 close(CONF);
 116 }
 117
 118
 119 # delete_share(share)
 120 # Delete some share from the config file
 121 sub delete_share
 122 {
 123 local($_, @conf, $deleting);
 124 open(CONF, $config{smb_conf});
 125 @conf = <CONF>;
 126 close(CONF);
 127 open(CONF, "> $config{smb_conf}");
 128 for($i=0; $i<@conf; $i++) {
 129         chop($_ = $conf[$i]); s/;.*$//g;
 130         if (/^\s*\[([^\]]+)\]/) {
 131                 if ($deleting) { $deleting = 0; }
 132                 elsif ($1 eq $_[0]) {
 133                         print CONF "\n";
 134                         $deleting = 1;
 135                         }
 136                 }
 137         if (!$deleting) { print CONF $conf[$i]; }
 138         }
 139 close(CONF);
 140 }
 141
 142
 143 # list_connections([share])
 144 # Uses the smbstatus program to return a list of connections a share. Each
 145 # element of the returned list is of the form:
 146 #  share, user, group, pid, hostname, date/time
 147 sub list_connections
 148 {
 149 local($l, $started, @rv);
 150 foreach $l (split(/\n/ , `$config{samba_status_program} -S`)) {
 151         if ($l =~ /^----/) { $started = 1; }
 152         if ($started && $l =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)\s+\(\S+\)\s+(.*)$/ && (!$_[0] || $1 eq $_[0] || $1 eq $2 && $_[0] eq "homes")) {
 153                 push(@rv, [ $1, $2, $3, $4, $5, $6 ]);
 154                 }
 155         }
 156 return @rv;
 157 }
 158
 159 # list_locks()
 160 # Returns a list of locked files as an array, in the form:
 161 #  pid, mode, rw, oplock, file, date
 162 sub list_locks
 163 {
 164 local($l, $started, @rv);
 165 foreach $l (split(/\n/ , `$config{samba_status_program} -L`)) {
 166         if ($l =~ /^----/) { $started = 1; }
 167         if ($started && $l =~ /^(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)\s+(\S+\s+\S+\s+\d+\s+\d+:\d+:\d+\s+\d+)/) {
 168                 push(@rv, [ $1, $2, $3, $4, $5, $6 ]);
 169                 }
 170         }
 171 return @rv;
 172 }
 173
 174
 175 # istrue(key)
 176 # Checks if the value of this key (or it's synonyms) in %share is true
 177 sub istrue
 178 {
 179 return &getval($_[0]) =~ /yes|true|1/i;
 180 }
 181
 182
 183 # isfalse(key)
 184 # Checks if the value of this key (or it's synonyms) in %share is false
 185 sub isfalse
 186 {
 187 return &getval($_[0]) =~ /no|false|0/i;
 188 }
 189
 190
 191 # getval(name)
 192 # Given the name of a key in %share, return the value. Also looks for synonyms.
 193 # If the value is not found, a default is looked for.. this can come from
 194 # a copied section, the [global] configuration section, or from the SAMBA
 195 # defaults. This means that getval() always returns something..
 196 sub getval
 197 {
 198 local($_, $copy);
 199 if ($synon{$_[0]}) {
 200         foreach (split(/,/, $synon{$_[0]})) {
 201                 if (defined($share{$_})) { return $share{$_}; }
 202                 }
 203         }
 204 if (defined($share{$_[0]})) {
 205         return $share{$_[0]};
 206         }
 207 elsif ($_[0] ne "copy" && ($copy = $share{"copy"})) {
 208         # this share is a copy.. get the value from the source
 209         local(%share);
 210         &get_share($copy);
 211         return &getval($_[0]);
 212         }
 213 else {
 214         # return the default value...
 215         return &default_value($_[0]);
 216         }
 217 return undef;
 218 }
 219
 220
 221 # setval(name, value, [default])
 222 # Sets some value in %share. Synonyms with the same meaning are removed.
 223 # If the value is the same as the share or given default, dont store it
 224 sub setval
 225 {
 226 local($_);
 227 if (@_ == 3) {
 228         # default was given..
 229         $def = $_[2];
 230         }
 231 elsif ($_[0] ne "copy" && ($copy = $share{"copy"})) {
 232         # get value from copy source..
 233         local(%share);
 234         &get_share($copy);
 235         $def = &getval($_[0]);
 236         }
 237 else {
 238         # get global/samba default
 239         $def = &default_value($_[0]);
 240         }
 241 if ($_[1] eq $def || ($def !~ /\S/ && $_[1] !~ /\S/) ||
 242     ($def =~ /^(true|yes|1)$/i && $_[1] =~ /^(true|yes|1)$/i) ||
 243     ($def =~ /^(false|no|0)$/i && $_[1] =~ /^(false|no|0)$/i)) {
 244         # The value is the default.. delete this entry
 245         &delval($_[0]);
 246         }
 247 else {
 248         if ($synon{$_[0]}) {
 249                 foreach (split(/,/, $synon{$_[0]})) {
 250                         delete($share{$_});
 251                         }
 252                 }
 253         $share{$_[0]} = $_[1];
 254         }
 255 }
 256
 257
 258 # delval(name)
 259 # Delete a value from %share (and it's synonyms)
 260 sub delval
 261 {
 262 local($_);
 263 if ($synon{$_[0]}) {
 264         foreach (split(/,/, $synon{$_[0]})) {
 265                 delete($share{$_});
 266                 }
 267         }
 268 else { delete($share{$_[0]}); }
 269 }
 270
 271
 272 # default_value(name)
 273 # Returns the default value for a parameter
 274 sub default_value
 275 {
 276 local($_, %global);
 277
 278 # First look in the [global] section.. (unless this _is_ the global section)
 279 if ($share{share_name} ne "global") {
 280         &get_share("global", "global");
 281         if ($synon{$_[0]}) {
 282                 foreach (split(/,/, $synon{$_[0]})) {
 283                         if (defined($global{$_})) { return $global{$_}; }
 284                         }
 285                 }
 286         if (defined($global{$_[0]})) { return $global{$_[0]}; }
 287         }
 288
 289 # Else look in the samba defaults
 290 if ($synon{$_[0]}) {
 291         foreach (split(/,/, $synon{$_[0]})) {
 292                 if (exists($default_values{$_})) {
 293                         return $default_values{$_};
 294                         }
 295                 }
 296         }
 297 return $default_values{$_[0]};
 298 }
 299
 300
 301 # The list of synonyms used by samba for parameter names
 302 @synon = (      "writable,write ok,writeable",
 303                 "public,guest ok",
 304                 "printable,print ok",
 305                 "allow hosts,hosts allow",
 306                 "deny hosts,hosts deny",
 307                 "create mode,create mask",
 308                 "directory mode,directory mask",
 309                 "path,directory",
 310                 "exec,preexec",
 311                 "group,force group",
 312                 "only guest,guest only",
 313                 "user,username,users",
 314                 "default,default service",
 315                 "auto services,preload",
 316                 "lock directory,lock dir",
 317                 "max xmit,max packet",
 318                 "root directory,root dir,root",
 319                 "case sensitive,case sig names"
 320          );
 321 foreach $s (@synon) {
 322         foreach $ss (split(/,/ , $s)) {
 323                 $synon{$ss} = $s;
 324                 }
 325         }
 326
 327
 328 # Default values for samba configuration parameters
 329 %default_values = (     "allow hosts",undef,
 330                         "alternate permissions","no",
 331                         "available","yes",
 332                         "browseable","yes",
 333                         "comment",undef,
 334                         "create mode","755",
 335                         "directory mode","755",
 336                         "default case","lower",
 337                         "case sensitive","no",
 338                         "mangle case","no",
 339                         "preserve case","no",
 340                         "short preserve case","no",
 341                         "delete readonly","no",
 342                         "deny hosts",undef,
 343                         "dont descend",undef,
 344                         "force group",undef,
 345                         "force user",undef,
 346                         "force create mode","000",
 347                         "force directory mode","000",
 348                         "guest account","nobody",       # depends
 349                         "guest only","no",
 350                         "hide dot files","yes",
 351                         "invalid users",undef,
 352                         "locking","yes",
 353                         "lppause command",undef,        # depends
 354                         "lpq command",undef,            # depends
 355                         "lpresume command",undef,       # depends
 356                         "lprm command",undef,           #depends
 357                         "magic output",undef,           # odd..
 358                         "magic script",undef,
 359                         "mangled map",undef,
 360                         "mangled names","yes",
 361                         "mangling char","~",
 362                         "map archive","yes",
 363                         "map system","no",
 364                         "map hidden","no",
 365                         "max connections",0,
 366                         "only user","no",
 367                         "fake oplocks","no",
 368                         "min print space",0,
 369                         "path",undef,
 370                         "postscript","no",
 371                         "preexec",undef,
 372                         "print command",undef,
 373 #                       "print command","lpr -r -P %p %s",
 374                         "printer",undef,
 375                         "printer driver",undef,
 376                         "public","no",
 377                         "read list",undef,
 378                         "revalidate","no",
 379                         "root preexec",undef,
 380                         "root postexec",undef,
 381                         "set directory","no",
 382                         "share modes","yes",
 383                         "strict locking","no",
 384                         "sync always","no",
 385                         "user",undef,
 386                         "valid chars",undef,
 387                         "volume",undef,         # depends
 388                         "wide links","yes",
 389                         "wins support","no",
 390                         "writable","no",
 391                         "write list",undef );
 392
 393 # user_list(list)
 394 # Convert a samba unix user list into a more readable form
 395 sub user_list
 396 {
 397 local($u, @rv);
 398 foreach $u (split(/[ \t,]+/ , $_[0])) {
 399         if ($u =~ /^\@(.*)$/) {
 400                 push(@rv, "group <tt>".&html_escape($1)."</tt>");
 401                 }
 402         else {
 403                 push(@rv, "<tt>".&html_escape($u)."</tt>");
 404                 }
 405         }
 406 return join("," , @rv);
 407 }
 408
 409
 410 # yesno_input(name)
 411 # Returns HTML for a true/false option
 412 sub yesno_input
 413 {
 414 ($n = $_[0]) =~ s/ /_/g;
 415 return sprintf "<input type=radio name=$n value=yes %s> $text{'yes'}\n".
 416                "<input type=radio name=$n value=no %s> $text{'no'}\n",
 417                 &istrue($_[0]) ? "checked" : "",
 418                 &isfalse($_[0]) ? "checked" : "";
 419 }
 420
 421 # username_input(name)
 422 # Outputs HTML for an username field
 423 sub username_input
 424 {
 425 ($n = $_[0]) =~ s/ /_/g;
 426 $v = &getval($_[0]);
 427 print "<td><input name=$n size=8 value=\"$v\"> ",
 428         &user_chooser_button($n, 0),"</td>\n";
 429 }
 430
 431 # username_input(name, default)
 432 sub groupname_input
 433 {
 434 ($n = $_[0]) =~ s/ /_/g;
 435 $v = &getval($_[0]);
 436 print "<td><input name=$n size=8 value=\"$v\"> ",
 437         &group_chooser_button($n, 0),"</td>\n";
 438 }
 439
 440
 441
 442 @sock_opts = ("SO_KEEPALIVE", "SO_REUSEADDR", "SO_BROADCAST", "TCP_NODELAY",
 443               "IPTOS_LOWDELAY", "IPTOS_THROUGHPUT", "SO_SNDBUF*", "SO_RCVBUF*",
 444               "SO_SNDLOWAT*", "SO_RCVLOWAT*");
 445
 446 @protocols = ("CORE", "COREPLUS", "LANMAN1", "LANMAN2", "NT1");
 447
 448
 449 # list_users()
 450 # Returns an array of all the users from the samba password file
 451 sub list_users
 452 {
 453 local(@rv, @b, $_, $lnum);
 454 open(PASS, $config{'smb_passwd'});
 455 while(<PASS>) {
 456         $lnum++;
 457         chop;
 458         s/#.*$//g;
 459         local @b = split(/:/, $_);
 460         next if (@b < 4);
 461         local $u = { 'name' => $b[0],  'uid' => $b[1],
 462                      'pass1' => $b[2], 'pass2' => $b[3] };
 463         if ($samba_version >= 2 && $b[4] =~ /^\[/) {
 464                 $b[4] =~ s/[\[\] ]//g;
 465                 $u->{'opts'} = [ split(//, $b[4]) ];
 466                 $u->{'change'} = $b[5];
 467                 }
 468         else {
 469                 $u->{'real'} = $b[4];
 470                 $u->{'home'} = $b[5];
 471                 $u->{'shell'} = $b[6];
 472                 }
 473         $u->{'index'} = scalar(@rv);
 474         $u->{'line'} = $lnum-1;
 475         push(@rv, $u);
 476         }
 477 close(PASS);
 478 return @rv;
 479 }
 480
 481 # create_user(&user)
 482 # Add a user to the samba password file
 483 sub create_user
 484 {
 485 open(PASS, ">>$config{'smb_passwd'}");
 486 print PASS &user_string($_[0]);
 487 close(PASS);
 488 chown(0, 0, $config{'smb_passwd'});
 489 chmod(0600, $config{'smb_passwd'});
 490 }
 491
 492 # modify_user(&user)
 493 # Change an existing samba user
 494 sub modify_user
 495 {
 496 &replace_file_line($config{'smb_passwd'}, $_[0]->{'line'}, &user_string($_[0]));
 497 }
 498
 499 # delete_user(&user)
 500 # Delete a samba user
 501 sub delete_user
 502 {
 503 &replace_file_line($config{'smb_passwd'}, $_[0]->{'line'});
 504 }
 505
 506 sub user_string
 507 {
 508 local @u = ($_[0]->{'name'}, $_[0]->{'uid'},
 509             $_[0]->{'pass1'}, $_[0]->{'pass2'});
 510 if ($_[0]->{'opts'}) {
 511         push(@u, sprintf "[%-11s]", join("", @{$_[0]->{'opts'}}));
 512         push(@u, sprintf "LCT-%X", time());
 513         }
 514 else {
 515         push(@u, $_[0]->{'real'}, $_[0]->{'home'}, $_[0]->{'shell'});
 516         }
 517 return join(":", @u).":\n";
 518 }
 519
 520 # set_password(user, password)
 521 # Changes the password of a user in the encrypted password file
 522 sub set_password
 523 {
 524 local($out);
 525 $out = `$config{'samba_password_program'} "$_[0]" "$_[1]" 2>&1 </dev/null`;
 526 return $out =~ /changed/;
 527 }
 528
 529 # is_samba_running()
 530 # Returns 0 if not, 1 if it is, or 2 if run from (x)inetd
 531 sub is_samba_running
 532 {
 533 local ($found_inet, @smbpids, @nmbpids);
 534 if (&foreign_check("inetd")) {
 535         &foreign_require("inetd", "inetd-lib.pl");
 536         foreach $inet (&foreign_call("inetd", "list_inets")) {
 537                 $found_inet++ if (($inet->[8] =~ /smbd/ ||
 538                                    $inet->[9] =~ /smbd/) && $inet->[1]);
 539                 }
 540         }
 541 elsif (&foreign_check("xinetd")) {
 542         &foreign_require("xinetd", "xinetd-lib.pl");
 543         foreach $xi (&foreign_call("xinetd", "get_xinetd_config")) {
 544                 local $q = $xi->{'quick'};
 545                 $found_inet++ if ($q->{'disable'}->[0] ne 'yes' &&
 546                                   $q->{'server'}->[0] =~ /smbd/);
 547                 }
 548         }
 549 @smbpids = &find_byname("smbd");
 550 @nmbpids = &find_byname("nmbd");
 551 return !$found_inet && !@smbpids && !@nmbpids ? 0 :
 552        !$found_inet ? 1 : 2;
 553 }
 554
 555 # can($permissions_string, \%access, [$sname])
 556 # check global and per-share permissions:
 557 #
 558 # $permissions_string = any exists permissions except 'c' (creation).
 559 # \%access = ref on what get_module_acl() returns.
 560 sub can
 561 {
 562 local ($acl, $stype, @perm);
 563 local ($perm, $acc, $sname) = @_;
 564 @perm  = split(//, $perm);
 565 $sname = $in{'old_name'} || $in{'share'} unless $sname;
 566
 567 {       local %share;
 568         &get_share($sname); # use local %share
 569         $stype = &istrue('printable') ? 'ps' : 'fs';
 570         }
 571
 572 # check global acl (r,w)
 573 foreach (@perm) {
 574         next if ($_ ne 'r') && ($_ ne 'w');
 575         return 0 unless $acc->{$_ . '_' . $stype};
 576         }
 577
 578 # check per-share acl
 579 if ($acc->{'per_' . $stype . '_acls'}) {
 580     $acl = $acc->{'ACL' . $stype . '_' . $sname};
 581     foreach (@perm) {
 582 #        next if $_ eq 'c'; # skip creation perms for per-share acls
 583                 return 0 if index($acl, $_) == -1;
 584                 }
 585         }
 586 return 1;
 587 }
 588
 589 # save_samba_acl($permissions_string, \%access, $share_name)
 590 sub save_samba_acl
 591 {
 592 local ($p, $a, $s)=@_;
 593 defined(%share) || &get_share($s); # use global %share
 594 local $t=&istrue('printable') ? 'ps' : 'fs';
 595 $a->{'ACL'. $t .'_'. $s} = $p;
 596 #undef($can_cache);
 597 return &save_module_acl($a);
 598 }
 599
 600 # drop_samba_acl(\%access, $share_name)
 601 sub drop_samba_acl
 602 {
 603 local ($a, $s)=@_;
 604 defined(%share) || &get_share($s); # use global %share
 605 local $t=&istrue('printable') ? 'ps' : 'fs';
 606 delete($a->{'ACL'. $t .'_' . $s});
 607 #undef($can_cache);
 608 return &save_module_acl($a);
 609 }
 610
 611 1;
 612