package fs::remote::smb; # $Id: smb.pm 258615 2009-07-27 06:26:03Z pterjan $




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 {

#début modif
    my (undef, @l2) = `nmblookup "*"; nmblookup -M -- -`;
    s/\s.*\n// foreach @l2; #ne garde que le premier mot de chaque élément
    require network::network;
    my @servers2 = grep { network::network::is_ip($_) } @l2; #ne garde que les IPs de la liste
    return unless @servers2; # sortie si aucun serveur trouvé
    my %servers2;
    $servers2{$_}{ip} = $_ foreach @servers2; #table de hachage: élimine les doubles
    my $ip2;
    foreach (`nmblookup -A @servers2`) { # liste des services de tous les serveurs détectés
      my $nb2 = /^Looking up status of (\S+)/ .. /^$/ or next;  # utilise la variable par défaut
      if ($nb2 == 1) {
        $ip2 = $1; # variable 1 de la substitution: adresse contenue dans 'Looking up ...'
      } elsif (/<00>/) {
        $servers2{$ip2}{/<GROUP>/ ? 'group' : 'name'} ||= lc first(/(\S+)/); # il s'agit d'un nom de GROUP ou d'hôte ?
      }
    }

    my @groupes, %groupes;
    foreach (%servers2){
    print "defaut: $_ \n";
    print "servers2 ip2 group: ", $servers2{$_}{'group'}, "\n";
    $groupes{$servers2{$_}{'group'}}{'group'} = $servers2{$_}{'group'};
    }
    push @groupes, $groupes{$_}{'group'} foreach %groupes;
    print "groupes: @groupes \n";

    my (undef, @l) = `nmblookup "*"; nmblookup @groupes; nmblookup -M -- -`;
#fin modif


#    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;