summaryrefslogtreecommitdiffstats
path: root/perl-install/fs/remote
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/fs/remote')
-rw-r--r--perl-install/fs/remote/davfs.pm99
-rw-r--r--perl-install/fs/remote/nfs.pm74
-rw-r--r--perl-install/fs/remote/smb.pm218
3 files changed, 391 insertions, 0 deletions
diff --git a/perl-install/fs/remote/davfs.pm b/perl-install/fs/remote/davfs.pm
new file mode 100644
index 000000000..890530cb9
--- /dev/null
+++ b/perl-install/fs/remote/davfs.pm
@@ -0,0 +1,99 @@
+package fs::remote::davfs;
+
+use strict;
+use diagnostics;
+
+use common;
+use fs::mount_options;
+
+sub secrets_file() { "$::prefix/etc/davfs2/secrets" }
+
+sub fstab_entry_to_credentials {
+ my ($part) = @_;
+
+ my ($options, $unknown) = fs::mount_options::unpack($part);
+ my %h = map { $_ => delete $options->{"$_="} } qw(username password);
+ foreach (qw(username password)) {
+ $h{$_} ||= 'nobody';
+ }
+ $h{mntpoint} = $part->{mntpoint} or return;
+ fs::mount_options::pack_($part, $options, $unknown), \%h;
+}
+
+sub save_credentials {
+ my ($credentials) = @_;
+ @$credentials or return;
+
+ output_with_perm(secrets_file(), 0600,
+ map { to_double_quoted($_->{mntpoint}, $_->{username}, $_->{password}) . "\n" } @$credentials);
+}
+
+sub mountpoint_credentials_save {
+ my ($mntpoint, $mount_opt) = @_;
+ my @entries = read_credentials_raw();
+ my $entry = find { $mntpoint eq $_->{mntpoint} } @entries;
+ die "mountpoint not found" if !$entry;
+ my %h;
+ foreach (@$mount_opt) {
+ my @var = split(/=/);
+ $h{$var[0]} = $var[1];
+ }
+ foreach my $key (qw(username password)) {
+ $entry->{$key} = $h{$key};
+ }
+ save_credentials(\@entries);
+}
+
+
+sub read_credentials_raw() {
+ from_double_quoted(cat_(secrets_file()));
+}
+
+sub read_credentials {
+ my ($mntpoint) = @_;
+ find { $mntpoint eq $_->{mntpoint} } read_credentials_raw();
+}
+
+# Comments are indicated by a '#' character and the rest of the line
+# is ignored. Empty lines are ignored too.
+#
+# Each line consists of two or three items separated by spaces or tabs.
+# If an item contains one of the characters space, tab, #, \ or ", this
+# character must be escaped by a preceding \. Alternatively, the item
+# may be enclosed in double quotes.
+
+sub from_double_quoted {
+ my ($file) = @_;
+ my @l;
+ my @lines = split("\n",$file);
+ foreach (@lines) {
+ my ($mnt, $user, $pass, $comment);
+ if (/^\s*(#.*)?$/) {
+ $comment = $1;
+ } else {
+ if (/^(?:"((?:\\.|[^"])*)"|((?:\\.|[^"\s#])+))\s+(?:"((?:\\.|[^"])*)"|((?:\\.|[^"\s#])+))(?:\s+(?:"((?:\\.|[^"])*)"|((?:\\.|[^"\s#])+)))?(?:\s*|\s*(#.*))?$/) {
+ $mnt = "$1$2";
+ $mnt =~ s/\\(.)/$1/g;
+ $user = "$3$4";
+ $user =~ s/\\(.)/$1/g;
+ $pass = "$5$6";
+ $pass =~ s/\\(.)/$1/g;
+ $comment=$7;
+ } else {
+ die "bad entry $_";
+ }
+ }
+ push @l, { 'mntpoint' => $mnt, 'username' => $user, 'password' => $pass, 'comment' => $comment };
+ }
+ @l;
+}
+
+sub to_double_quoted {
+ my (@l) = @_;
+ join(' ', map {
+ s/(["\\])/\\$1/g;
+ /\s/ ? qq("$_") : $_;
+ } @l);
+}
+
+1;
diff --git a/perl-install/fs/remote/nfs.pm b/perl-install/fs/remote/nfs.pm
new file mode 100644
index 000000000..f7a98cb69
--- /dev/null
+++ b/perl-install/fs/remote/nfs.pm
@@ -0,0 +1,74 @@
+package fs::remote::nfs;
+
+use strict;
+use diagnostics;
+
+use common;
+use fs::remote;
+use network::tools;
+use log;
+
+our @ISA = 'fs::remote';
+
+sub to_fstab_entry {
+ my ($class, $e) = @_;
+ $class->to_fstab_entry_raw($e, 'nfs');
+}
+sub comment_to_string {
+ my ($_class, $comment) = @_;
+ member($comment, qw(* 0.0.0.0/0.0.0.0 (everyone))) ? '' : $comment;
+}
+sub from_dev {
+ my ($_class, $dev) = @_;
+ $dev =~ m|(.*?):(.*)|;
+}
+sub to_dev_raw {
+ my ($_class, $server, $name) = @_;
+ $server . ':' . $name;
+}
+
+sub check {
+ my ($_class, $in) = @_;
+ $in->do_pkgs->ensure_files_are_installed([ [ qw(nfs-utils showmount) ] , [ qw(nmap nmap) ] ]);
+ require services;
+ services::start_not_running_service('rpcbind');
+ services::start('nfs-common'); #- TODO: once nfs-common is fixed, it could use start_not_running_service()
+ 1;
+}
+
+sub find_servers {
+ my @hosts;
+ my %servers;
+ my @routes = cat_("/proc/net/route");
+ @routes = reverse(@routes) if common::cmp_kernel_versions(c::kernel_version(), "2.6.39") >= 0;
+ foreach (@routes) {
+ if (/^(\S+)\s+([0-9A-F]+)\s+([0-9A-F]+)\s+[0-9A-F]+\s+\d+\s+\d+\s+(\d+)\s+([0-9A-F]+)/) {
+ my $net = network::tools::host_hex_to_dotted($2);
+ my $gateway = $3;
+ # get the netmask in binary and remove leading zeros
+ my $mask = unpack('B*', pack('h*', $5));
+ $mask =~ s/^0*//;
+ push @hosts, $net . "/" . length($mask) if $gateway eq '00000000' && $net ne '169.254.0.0';
+ }
+ }
+ # runs the nmap command on the local subnet
+ my $cmd = "/usr/bin/nmap -p 111 --open --system-dns -oG - " . (join ' ',@hosts);
+ open my $FH, "$cmd |" or die "Could not perform nmap scan - $!";
+ foreach (<$FH>) {
+ my ($ip, $name) = /^H\S+\s(\S+)\s+\((\S*)\).+Port/ or next;
+ $servers{$ip} ||= { ip => $ip, name => $name || $ip };
+ }
+ close $FH;
+ values %servers;
+}
+
+sub find_exports {
+ my ($_class, $server) = @_;
+
+ my @l;
+ run_program::raw({ timeout => 1 }, "showmount", '>', \@l, "--no-headers", "-e", $server->{ip} || $server->{name});
+
+ map { if_(/(\S+(\s*\S+)*)\s+(\S+)/, { name => $1, comment => $3, server => $server }) } @l;
+}
+
+1;
diff --git a/perl-install/fs/remote/smb.pm b/perl-install/fs/remote/smb.pm
new file mode 100644
index 000000000..d440fc174
--- /dev/null
+++ b/perl-install/fs/remote/smb.pm
@@ -0,0 +1,218 @@
+package fs::remote::smb;
+
+use strict;
+use diagnostics;
+
+use common;
+use fs::mount_options;
+use fs::remote;
+
+
+our @ISA = 'fs::remote';
+
+sub to_fstab_entry {
+ my ($class, $e) = @_;
+ my $part = $class->to_fstab_entry_raw($e, 'cifs');
+ if ($e->{server}{username}) {
+ my ($options, $unknown) = fs::mount_options::unpack($part);
+ $options->{"$_="} = $e->{server}{$_} foreach qw(username password domain);
+ fs::mount_options::pack($part, $options, $unknown);
+ }
+ $part;
+}
+sub from_dev {
+ my ($_class, $dev) = @_;
+ $dev =~ m|//(.*?)/(.*)|;
+}
+sub to_dev_raw {
+ my ($_class, $server, $name) = @_;
+ '//' . $server . '/' . $name;
+}
+
+sub check {
+ my ($_class, $in) = @_;
+ $in->do_pkgs->ensure_binary_is_installed('samba-client', 'nmblookup');
+}
+
+sub smbclient {
+ my ($server) = @_;
+ my $name = $server->{name} || $server->{ip};
+ my $ip = $server->{ip} ? "-I $server->{ip}" : '';
+ my $group = $server->{group} ? qq( -W "$server->{group}") : '';
+
+ my $U = $server->{username} ? sprintf("%s/%s%%%s", @$server{'domain', 'username', 'password'}) : '%';
+ my %h;
+ foreach (`smbclient -g -U "$U" -L "$name" $ip$group 2>/dev/null`) {
+ if (my ($type, $v1, $v2) = /(.*)\|(.*)\|(.*)/) {
+ push @{$h{$type}}, [ $v1, $v2 ];
+ } elsif (/^Error returning browse list/) {
+ push @{$h{Error}}, $_;
+ }
+ }
+ \%h;
+}
+
+sub find_servers {
+ my (undef, @l) = `nmblookup "*"; nmblookup -M -- -`;
+ s/\s.*\n// foreach @l;
+ require network::network;
+ my @servers = grep { network::network::is_ip($_) } @l;
+ return unless @servers;
+ my %servers;
+ $servers{$_}{ip} = $_ foreach @servers;
+ my ($ip, $browse);
+ foreach (`nmblookup -A @servers`) {
+ my $nb = /^Looking up status of (\S+)/ .. /^$/ or next;
+ if ($nb == 1) {
+ $ip = $1;
+ } elsif (/<00>/) {
+ $servers{$ip}{/<GROUP>/ ? 'group' : 'name'} ||= lc first(/(\S+)/);
+ } elsif (/__MSBROWSE__/) {
+ $browse ||= $servers{$ip};
+ }
+ }
+ if ($browse) {
+ my %l;
+ my $workgroups = smbclient($browse)->{Workgroup} || [];
+ foreach (@$workgroups) {
+ my ($group, $name) = map { lc($_) } @$_;
+
+ # already done
+ next if any { $group eq $_->{group} } values %servers;
+
+ $l{$name} = $group;
+ }
+ if (my @l = keys %l) {
+ foreach (`nmblookup @l`) {
+ $servers{$1} = { name => $2, group => $l{$2} } if /(\S+)\s+([^<]+)<00>/;
+ }
+ }
+ }
+ values %servers;
+}
+
+sub find_exports {
+ my ($_class, $server) = @_;
+ my @l;
+
+ my $browse = smbclient($server);
+ if (my $err = find { /NT_STATUS_/ } @{$browse->{Error} || []}) {
+ die $err;
+ }
+ foreach (@{$browse->{Disk} || []}) {
+ my ($name, $comment) = @$_;
+ push @l, { name => $name, type => 'Disk', comment => $comment, server => $server }
+ if $name !~ /\$$/ && $name !~ /netlogon|NETLOGON|SYSVOL/;
+ }
+ @l;
+}
+
+sub authentications_available {
+ my ($server) = @_;
+ map { if_(/^auth.\Q$server->{name}.\E(.*)/, $1) } all("/etc/samba");
+}
+
+sub to_credentials {
+ my ($server_name, $username) = @_;
+ $username or die 'to_credentials';
+ "/etc/samba/auth.$server_name.$username";
+}
+
+sub fstab_entry_to_credentials {
+ my ($part) = @_;
+
+ my ($server_name) = fs::remote::smb->from_dev($part->{device}) or return;
+
+ my ($options, $unknown) = fs::mount_options::unpack($part);
+ $options->{'username='} && $options->{'password='} or return;
+ my %h = map { $_ => delete $options->{"$_="} } qw(username password);
+ $h{file} = $options->{'credentials='} = to_credentials($server_name, $h{username});
+ fs::mount_options::pack_($part, $options, $unknown), \%h;
+}
+
+sub remove_bad_credentials {
+ my ($server) = @_;
+ unlink to_credentials($server->{name}, $server->{username});
+}
+
+sub save_credentials {
+ my ($credentials) = @_;
+ my $file = $credentials->{file};
+ output_with_perm("$::prefix$file", 0640, map { "$_=$credentials->{$_}\n" } qw(username password));
+}
+
+
+sub read_credentials_raw {
+ my ($file) = @_;
+ my %h = map { /(.*?)\s*=\s*(.*)/ } cat_("$::prefix$file");
+ \%h;
+}
+
+sub read_credentials {
+ my ($server, $username) = @_;
+ put_in_hash($server, read_credentials_raw(to_credentials($server->{name}, $username)));
+}
+
+
+sub write_smb_conf {
+ my ($domain) = @_;
+
+ #- was going to just have a canned config in samba-winbind
+ #- and replace the domain, but sylvestre/buchan did not bless it yet
+
+ my $f = "$::prefix/etc/samba/smb.conf";
+ rename $f, "$f.orig";
+ output($f, "
+[global]
+ workgroup = $domain
+ server string = Samba Server %v
+ security = domain
+ encrypt passwords = Yes
+ password server = *
+ log file = /var/log/samba/log.%m
+ max log size = 50
+ socket options = TCP_NODELAY SO_RCVBUF=8192 SO_SNDBUF=8192
+ unix charset = ISO8859-15
+ os level = 18
+ local master = No
+ dns proxy = No
+ idmap uid = 10000-20000
+ idmap gid = 10000-20000
+ winbind separator = +
+ template homedir = /home/%D/%U
+ template shell = /bin/bash
+ winbind use default domain = yes
+");
+}
+
+sub write_smb_ads_conf {
+ my ($domain, $realm) = @_;
+
+ #- was going to just have a canned config in samba-winbind
+ #- and replace the domain, but sylvestre/buchan did not bless it yet
+
+ my $f = "$::prefix/etc/samba/smb.conf";
+ rename $f, "$f.orig";
+ output($f, "
+[global]
+ workgroup = $domain
+ realm = $realm
+ server string = Samba Member %v
+ security = ads
+ encrypt passwords = Yes
+ password server = *
+ log file = /var/log/samba/log.%m
+ max log size = 50
+ socket options = TCP_NODELAY SO_RCVBUF=8192 SO_SNDBUF=8192
+ os level = 18
+ local master = No
+ dns proxy = No
+ winbind uid = 10000-20000
+ winbind gid = 10000-20000
+ winbind separator = +
+ template homedir = /home/%D/%U
+ template shell = /bin/bash
+ winbind use default domain = yes
+");
+}
+1;
generated by cgit v1.2.1 (git 2.21.0) at 2025-10-31 04:25:02 +0000