You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
431 lines
11 KiB
431 lines
11 KiB
#!/usr/bin/perl -T
|
|
use strict;
|
|
|
|
########################################
|
|
# config files
|
|
$nfs_exports::default_options = '*(ro,all_squash)';
|
|
$nfs_exports::conf_file = '/etc/exports';
|
|
$smb_exports::conf_file = '/etc/samba/smb.conf';
|
|
my $authorisation_file = '/etc/security/fileshare.conf';
|
|
my $authorisation_group = 'fileshare';
|
|
|
|
|
|
########################################
|
|
# Copyright (C) 2001-2002 MandrakeSoft (pixel@mandrakesoft.com)
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2, or (at your option)
|
|
# any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the Free Software
|
|
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
|
|
|
|
########################################
|
|
my $uid = $<;
|
|
my $username = getpwuid($uid);
|
|
|
|
########################################
|
|
# errors
|
|
my $usage =
|
|
"usage: fileshareset --add <dir>
|
|
fileshareset --remove <dir>";
|
|
my $not_enabled =
|
|
qq(File sharing is not enabled.
|
|
To enable file sharing put
|
|
"FILESHARING=yes" in $authorisation_file);
|
|
|
|
my $not_simple_enabled =
|
|
qq(Simple file sharing is not enabled.
|
|
To enable simple file sharing put
|
|
"SHARINGMODE=simple" in $authorisation_file);
|
|
|
|
my $non_authorised =
|
|
qq(You are not authorised to use file sharing
|
|
To grant you the rights:
|
|
- put "RESTRICT=no" in $authorisation_file
|
|
- or put user "$username" in group "$authorisation_group");
|
|
|
|
my $no_export_method = "can't export anything: no nfs, no smb";
|
|
|
|
my %exit_codes = reverse (
|
|
1 => $non_authorised,
|
|
2 => $usage,
|
|
|
|
# when adding
|
|
3 => "already exported",
|
|
4 => "invalid mount point",
|
|
|
|
# when removing
|
|
5 => "not exported",
|
|
|
|
6 => $no_export_method,
|
|
|
|
7 => $not_enabled,
|
|
|
|
8 => $not_simple_enabled,
|
|
|
|
255 => "various",
|
|
);
|
|
|
|
################################################################################
|
|
# correct PATH needed to call /etc/init.d/... ? seems not, but...
|
|
%ENV = ();#(PATH => '/bin:/sbin:/usr/bin:/usr/sbin');
|
|
|
|
my $modify = $0 =~ /fileshareset/;
|
|
|
|
authorisation::check($modify);
|
|
|
|
my @exports = (
|
|
-e $nfs_exports::conf_file ? nfs_exports::read() : (),
|
|
-e $smb_exports::conf_file ? smb_exports::read() : (),
|
|
);
|
|
@exports or error($no_export_method);
|
|
|
|
if ($modify) {
|
|
my ($cmd, $dir) = @ARGV;
|
|
$< = $>;
|
|
@ARGV == 2 && ($cmd eq '--add' || $cmd eq '--remove') or error($usage);
|
|
|
|
verify_mntpoint($dir);
|
|
|
|
if ($cmd eq '--add') {
|
|
my @errs = map { eval { $_->add($dir) }; $@ } @exports;
|
|
grep { !$_ } @errs or error("already exported");
|
|
} else {
|
|
my @errs = map { eval { $_->remove($dir) }; $@ } @exports;
|
|
grep { !$_ } @errs or error("not exported");
|
|
}
|
|
foreach my $export (@exports) {
|
|
$export->write;
|
|
$export->update_server;
|
|
}
|
|
}
|
|
my @mntpoints = grep {$_} uniq(map { map { $_->{mntpoint} } @$_ } @exports);
|
|
print "$_\n" foreach grep { own($_) } @mntpoints;
|
|
|
|
|
|
sub own { $uid == 0 || (stat($_[0]))[4] == $uid }
|
|
|
|
sub verify_mntpoint {
|
|
local ($_) = @_;
|
|
my $ok = 1;
|
|
$ok &&= m|^/|;
|
|
$ok &&= !m|/\.\./|;
|
|
$ok &&= !m|[\0\n\r]|;
|
|
$ok &&= -d $_;
|
|
$ok &&= own($_);
|
|
$ok or error("invalid mount point");
|
|
}
|
|
|
|
sub error {
|
|
my ($string) = @_;
|
|
print STDERR "$string\n";
|
|
exit($exit_codes{$string} || 255);
|
|
}
|
|
sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
|
|
sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
|
|
|
|
|
|
################################################################################
|
|
package authorisation;
|
|
|
|
sub read_conf {
|
|
my ($exclusive_lock) = @_;
|
|
open F_lock, $authorisation_file; # don't care if it's missing
|
|
flock(F_lock, $exclusive_lock ? 2 : 1) or die "can't lock";
|
|
my %conf;
|
|
foreach (<F_lock>) {
|
|
s/#.*//; # remove comments
|
|
s/^\s+//;
|
|
s/\s+$//;
|
|
/^$/ and next;
|
|
my ($cmd, $value) = split('=', $_, 2);
|
|
$conf{$cmd} = $value || warn qq(suspicious line "$_" in $authorisation_file\n);
|
|
}
|
|
# no close F_lock, keep it locked
|
|
\%conf
|
|
}
|
|
|
|
sub check {
|
|
my ($exclusive_lock) = @_;
|
|
my $conf = read_conf($exclusive_lock);
|
|
if (lc($conf->{FILESHARING}) eq 'no') {
|
|
::error($not_enabled);
|
|
}
|
|
|
|
if (lc($conf->{SHARINGMODE}) eq 'advanced') {
|
|
::error($not_simple_enabled);
|
|
}
|
|
|
|
if (lc($conf->{FILESHAREGROUP} ne '')) {
|
|
$authorisation_group = lc($conf->{FILESHAREGROUP});
|
|
}
|
|
|
|
if (lc($conf->{RESTRICT}) eq 'no') {
|
|
# ok, access granted for everybody
|
|
} else {
|
|
my @l;
|
|
while (@l = getgrent) {
|
|
last if $l[0] eq $authorisation_group;
|
|
}
|
|
::member($username, split(' ', $l[3])) or ::error($non_authorised);
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
package exports;
|
|
|
|
sub tqfind {
|
|
my ($exports, $mntpoint) = @_;
|
|
foreach (@$exports) {
|
|
$_->{mntpoint} eq $mntpoint and return $_;
|
|
}
|
|
undef;
|
|
}
|
|
|
|
sub add {
|
|
my ($exports, $mntpoint) = @_;
|
|
foreach (@$exports) {
|
|
$_->{mntpoint} eq $mntpoint and die 'add';
|
|
}
|
|
push @$exports, my $e = { mntpoint => $mntpoint };
|
|
$e;
|
|
}
|
|
|
|
sub remove {
|
|
my ($exports, $mntpoint) = @_;
|
|
my @l = grep { $_->{mntpoint} ne $mntpoint } @$exports;
|
|
@l < @$exports or die 'remove';
|
|
@$exports = @l;
|
|
}
|
|
|
|
|
|
################################################################################
|
|
package nfs_exports;
|
|
|
|
use vars qw(@ISA $conf_file $default_options);
|
|
BEGIN { @ISA = 'exports' }
|
|
|
|
sub read {
|
|
my $file = $conf_file;
|
|
local *F;
|
|
open F, $file or return [];
|
|
|
|
my ($prev_raw, $prev_line, %e, @l);
|
|
my $line_nb = 0;
|
|
foreach my $raw (<F>) {
|
|
$line_nb++;
|
|
local $_ = $raw;
|
|
$raw .= "\n" if !/\n/;
|
|
|
|
s/#.*//; # remove comments
|
|
|
|
s/^\s+//;
|
|
s/\s+$//; # remove unuseful spaces to help regexps
|
|
|
|
if (/^$/) {
|
|
# blank lines ignored
|
|
$prev_raw .= $raw;
|
|
next;
|
|
}
|
|
|
|
if (/\\$/) {
|
|
# line continue across lines
|
|
chop; # remove the backslash
|
|
$prev_line .= "$_ ";
|
|
$prev_raw .= $raw;
|
|
next;
|
|
}
|
|
my $line = $prev_line . $_;
|
|
my $raw_line = $prev_raw . $raw;
|
|
($prev_line, $prev_raw) = ('', '');
|
|
|
|
my ($mntpoint, $options) = $line =~ /("[^"]*"|\S+)\s+(.*)/ or die "$file:$line_nb: bad line $line\n";
|
|
|
|
# You can also specify spaces or any other unusual characters in the
|
|
# export path name using a backslash followed by the character code as
|
|
# 3 octal digits.
|
|
$mntpoint =~ s/\\(\d{3})/chr(oct $1)/ge;
|
|
|
|
# not accepting weird characters that would break the output
|
|
$mntpoint =~ m/[\0\n\r]/ and die "i won't handle this";
|
|
push @l, { mntpoint => $mntpoint, option => $options, raw => $raw_line };
|
|
}
|
|
bless \@l, 'nfs_exports';
|
|
}
|
|
|
|
sub write {
|
|
my ($nfs_exports) = @_;
|
|
foreach (@$nfs_exports) {
|
|
if (!exists $_->{options}) {
|
|
$_->{options} = $default_options;
|
|
}
|
|
if (!exists $_->{raw}) {
|
|
my $mntpoint = $_->{mntpoint} =~ /\s/ ? qq("$_->{mntpoint}") : $_->{mntpoint};
|
|
$_->{raw} = sprintf("%s %s\n", $mntpoint, $_->{options});
|
|
}
|
|
}
|
|
local *F;
|
|
open F, ">$conf_file" or die "can't write $conf_file";
|
|
print F $_->{raw} foreach @$nfs_exports;
|
|
}
|
|
|
|
sub update_server {
|
|
if (fork) {
|
|
system('/usr/sbin/exportfs', '-r');
|
|
if (system('PATH=/bin:/sbin pidof rpc.mountd >/dev/null') != 0 ||
|
|
system('PATH=/bin:/sbin pidof nfsd >/dev/null') != 0) {
|
|
# trying to start the server...
|
|
system('/etc/init.d/portmap start') if system('/etc/init.d/portmap status') != 0;
|
|
if ( -f '/etc/init.d/nfs' ) {
|
|
system('/etc/init.d/nfs', $_) foreach 'stop', 'start';
|
|
}
|
|
elsif ( -f '/etc/init.d/nfs-kernel-server' ) {
|
|
system('/etc/init.d/nfs-kernel-server', $_) foreach 'stop', 'start';
|
|
}
|
|
}
|
|
exit 0;
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
package smb_exports;
|
|
|
|
use vars qw(@ISA $conf_file);
|
|
BEGIN { @ISA = 'exports' }
|
|
|
|
sub read {
|
|
my ($s, @l);
|
|
local *F;
|
|
open F, $conf_file;
|
|
local $_;
|
|
while (<F>) {
|
|
if (/^\s*\[.*\]/ || eof F) {
|
|
#- first line in the category
|
|
my ($label) = $s =~ /^\s*\[(.*)\]/;
|
|
my ($mntpoint) = $s =~ /^\s*path\s*=\s*(.*)/m;
|
|
push @l, { mntpoint => $mntpoint, raw => $s, label => $label };
|
|
$s = '';
|
|
}
|
|
$s .= $_;
|
|
}
|
|
bless \@l, 'smb_exports';
|
|
}
|
|
|
|
sub write {
|
|
my ($smb_exports) = @_;
|
|
foreach (@$smb_exports) {
|
|
if (!exists $_->{raw}) {
|
|
$_->{raw} = <<EOF;
|
|
|
|
[$_->{label}]
|
|
path = $_->{mntpoint}
|
|
comment = $_->{mntpoint}
|
|
public = yes
|
|
guest ok = yes
|
|
writable = no
|
|
wide links = no
|
|
EOF
|
|
}
|
|
}
|
|
local *F;
|
|
open F, ">$conf_file" or die "can't write $conf_file";
|
|
print F $_->{raw} foreach @$smb_exports;
|
|
}
|
|
|
|
sub add {
|
|
my ($exports, $mntpoint) = @_;
|
|
my $e = $exports->exports::add($mntpoint);
|
|
$e->{label} = name_mangle($mntpoint, map { $_->{label} } @$exports);
|
|
}
|
|
|
|
sub name_mangle {
|
|
my ($input, @others) = @_;
|
|
|
|
local $_ = $input;
|
|
|
|
# 1. first only keep legal characters. "/" is also kept for the moment
|
|
tr|a-z|A-Z|;
|
|
s|[^A-Z0-9#\-_!/]|_|g; # "$" is allowed except at the end, remove it in any case
|
|
|
|
# 2. removing non-interesting parts
|
|
s|^/||;
|
|
s|^home/||;
|
|
s|_*/_*|/|g;
|
|
s|_+|_|g;
|
|
|
|
# 3. if size is too small (!), make it bigger
|
|
$_ .= "_" while length($_) < 3;
|
|
|
|
# 4. if size is too big, shorten it
|
|
while (length > 12) {
|
|
my ($s) = m|.*?/(.*)|;
|
|
if (length($s) > 8 && !grep { /\Q$s/ } @others) {
|
|
# dropping leading directories when the resulting is still long and meaningful
|
|
$_ = $s;
|
|
next;
|
|
}
|
|
s|(.*)[0-9#\-_!/]|$1| and next;
|
|
|
|
# inspired by "Christian Brolin" "Long names are doom" on comp.lang.functional
|
|
s|(.+)[AEIOU]|$1| and next; # allButFirstVowels
|
|
s|(.*)(.)\2|$1$2| and next; # adjacentDuplicates
|
|
|
|
s|(.*).|$1|; # booh, :'-(
|
|
}
|
|
|
|
# 5. remove "/"s still there
|
|
s|/|_|g;
|
|
|
|
# 6. resolving conflicts
|
|
my $l = join("|", map { quotemeta } @others);
|
|
my $conflicts = qr|^($l)$|;
|
|
if (/$conflicts/) {
|
|
A: while (1) {
|
|
for (my $nb = 1; length("$_$nb") <= 12; $nb++) {
|
|
if ("$_$nb" !~ /$conflicts/) {
|
|
$_ = "$_$nb";
|
|
last A;
|
|
}
|
|
}
|
|
$_ or die "can't tqfind a unique name";
|
|
# can't tqfind a unique name, dropping the last letter
|
|
s|(.*).|$1|;
|
|
}
|
|
}
|
|
|
|
# 7. done
|
|
$_;
|
|
}
|
|
|
|
sub update_server {
|
|
if (fork) {
|
|
system('/usr/bin/killall -HUP smbd 2>/dev/null');
|
|
if (system('PATH=/bin:/sbin pidof smbd >/dev/null') != 0 ||
|
|
system('PATH=/bin:/sbin pidof nmbd >/dev/null') != 0) {
|
|
# trying to start the server...
|
|
if ( -f '/etc/init.d/smb' ) {
|
|
system('/etc/init.d/smb', $_) foreach 'stop', 'start';
|
|
}
|
|
elsif ( -f '/etc/init.d/samba' ) {
|
|
system('/etc/init.d/samba', $_) foreach 'stop', 'start';
|
|
}
|
|
elsif ( -f '/etc/rc.d/rc.samba' ) {
|
|
system('/etc/rc.d/rc.samba', $_) foreach 'stop', 'start';
|
|
}
|
|
else {
|
|
print STDERR "Error: Can't tqfind the samba init script \n";
|
|
}
|
|
}
|
|
exit 0;
|
|
}
|
|
}
|