summaryrefslogtreecommitdiffstats
path: root/perl-install/standalone/fileshareset
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/standalone/fileshareset')
-rwxr-xr-xperl-install/standalone/fileshareset407
1 files changed, 407 insertions, 0 deletions
diff --git a/perl-install/standalone/fileshareset b/perl-install/standalone/fileshareset
new file mode 100755
index 000000000..9223d6f29
--- /dev/null
+++ b/perl-install/standalone/fileshareset
@@ -0,0 +1,407 @@
+#!/usr/bin/perl -T
+use strict;
+
+########################################
+# config files
+$nfs_exports::default_options = '*(ro,all_squash,sync,no_subtree_check)';
+$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-2008 Mandriva (pixel)
+#
+# 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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 fileshare'ing
+To grant you the rights:
+- put "RESTRICT=no" in $authorisation_file
+- or put user "$username" in group "$authorisation_group");
+my $no_export_method = "cannot 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 && (member($cmd, qw(--add --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|\Q/../|;
+ $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;
+
+my $F_lock;
+sub read_conf {
+ my ($exclusive_lock) = @_;
+ open $F_lock, $authorisation_file; # do not care if it's missing
+ flock($F_lock, $exclusive_lock ? 2 : 1) or die "cannot 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);
+ } elsif (lc($conf->{SHARINGMODE}) eq 'advanced') {
+ ::error($not_simple_enabled);
+ } elsif ($conf->{FILESHAREGROUP}) {
+ $authorisation_group = $conf->{FILESHAREGROUP};
+ } elsif (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 _find {
+ my ($exports, $mntpoint) = @_;
+ foreach (@$exports) {
+ $_->{mntpoint} eq $mntpoint and return $_;
+ }
+ undef;
+}
+
+sub add {
+ my ($exports, $mntpoint) = @_;
+ _find($exports, $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;
+ open(my $F, $file) or return [];
+
+ my ($prev_raw, $prev_line, @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 will not 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});
+ }
+ }
+ open(my $F, ">$conf_file") or die "cannot 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 >/dev/null') != 0;
+ system('/etc/init.d/nfs', $_) foreach 'stop', 'start';
+ }
+ exit 0;
+ }
+}
+
+################################################################################
+package smb_exports;
+
+use vars qw(@ISA $conf_file);
+BEGIN { @ISA = 'exports' }
+
+sub read() {
+ my ($s, @l);
+ open(my $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
+ }
+ }
+ open(my $F, ">$conf_file") or die "cannot 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;
+ } else {
+ s|(.*)[0-9#\-_!/]|$1|
+ # inspired by "Christian Brolin" "Long names are doom" on comp.lang.functional
+ || s|(.+)[AEIOU]|$1|# allButFirstVowels
+ || s|(.*)(.)\2|$1$2| # 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 "cannot find a unique name";
+ # cannot find 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...
+ my ($f) = grep { -f $_ } map { "/etc/init.d/$_" } 'smb', 'samba', 'rc.samba';
+ if ($f) {
+ system($f, $_) foreach 'stop', 'start';
+ } else {
+ print STDERR "Error: Can't find the samba init script \n";
+ }
+ }
+ exit 0;
+ }
+}
generated by cgit v1.2.1 (git 2.21.0) at 2025-10-23 15:19:34 +0000