summaryrefslogtreecommitdiffstats
path: root/perl-install/install_any.pm
Commit message (Expand)AuthorAgeFilesLines
* (getAndSaveFile) log which file copy failled in order to knwow whichThierry Vignaud2003-11-251-1/+1
* $o->{fstab} now contains get_really_all_fstab, not get_all_fstabPascal Rigaux2003-11-201-1/+1
* getHds called by install_steps must not be interactivePascal Rigaux2003-11-181-2/+2
* fix bogus use of old netwok module instead of network::networkThierry Vignaud2003-11-121-2/+2
* pass $o to getNextStepPascal Rigaux2003-10-151-2/+3
* drop field {next} in {steps} since it is duplicated in orderedStepsPascal Rigaux2003-10-151-3/+1
* aaaah that's why I had all the stuff done twice after shell could not be run :)Guillaume Cottenceau2003-10-101-5/+8
* help dumb perl_checkerGuillaume Cottenceau2003-10-091-1/+2
* thx perl checkerGuillaume Cottenceau2003-10-091-1/+1
* first try with /bin/bash which is available in move. specify --rcfile or else...Guillaume Cottenceau2003-10-091-4/+6
* report error why /dev/tty2 is not available for opening a shellGuillaume Cottenceau2003-10-091-1/+1
* notice bugThierry Vignaud2003-10-031-0/+1
* added missing kernel-i686-up-4GB entry for kernel modules.Francois Pons2003-10-011-1/+1
* no need to escape " in /xxx \" xxx/Pascal Rigaux2003-09-301-1/+1
* perl_checker fixesPascal Rigaux2003-09-291-2/+2
* removing update media tag (except for update medium)Francois Pons2003-09-161-2/+2
* added default compssUsers group selection from compssUser file directly (useFrancois Pons2003-08-261-8/+9
* updated with new perl-URPM 0.94 (simplified code)Francois Pons2003-08-211-20/+7
* avoid 0 to be dumped in urpmi.cfg :(Francois Pons2003-08-211-2/+2
* added some log when importing pbukey block and when key id have been found.Francois Pons2003-08-211-1/+5
* make sure other key are added to urpmi.cfg when imported.Francois Pons2003-08-211-3/+3
* added missing require.Francois Pons2003-08-201-0/+1
* added pubkey and rpmdb key importation.Francois Pons2003-08-201-1/+26
* - Don't care about BIGMEM stuff for IA-64 & AMD64Gwenolé Beauchesne2003-08-191-1/+2
* Fixing Nvidia detection.. Many were missing due to wrong regexpErwan Velu2003-08-191-5/+5
* fixed to build an inflexion point in list file (so that urpmi can found it).Francois Pons2003-08-131-5/+6
* generate a list file if a macro is used (and only in this case).Francois Pons2003-08-131-3/+9
* fixed with_hdlist possibly incorrect.Francois Pons2003-08-131-1/+12
* added tiny support for arch dependant directory.Francois Pons2003-08-131-1/+5
* use $::prefix instead of passing $prefix to functionsPascal Rigaux2003-08-101-4/+3
* add flag UTF8 for rpmsratePascal Rigaux2003-08-051-0/+1
* - move write_smb_conf() from install_any to network::smbPascal Rigaux2003-08-011-68/+8
* use $::prefixPascal Rigaux2003-08-011-4/+3
* perl_checker adaptations + fixesPascal Rigaux2003-04-241-10/+6
* perl_checker compliance for optional method argumentsPascal Rigaux2003-04-221-5/+5
* fix bug #3652 (grub must be installed for a loopback install)Pascal Rigaux2003-04-221-0/+1
* make all CD as update (as it should have been to allow updates to be resolved).Francois Pons2003-04-181-1/+1
* new perl_checker compliancePascal Rigaux2003-04-171-20/+20
* moved hdInstallPath to any.pm.Francois Pons2003-03-261-8/+2
* alsa drivers are now named snd-<name> not anymore snd-card-<name>Thierry Vignaud2003-03-131-1/+1
* added log for kernel module packages found.Francois Pons2003-03-121-0/+1
* use quoted url instead for install_urpmi.Francois Pons2003-03-101-1/+1
* fixed duplicate url entry for file and removable.Francois Pons2003-03-101-1/+1
* build a list file only if needed for install_urpmi.Francois Pons2003-03-101-26/+29
* cleanupPascal Rigaux2003-03-061-1/+1
* dropped allowNVIDIA_rpms method.Francois Pons2003-03-061-22/+0
* added check_kernel_module_packages for checking prioprietary base kernel pack...Francois Pons2003-03-061-0/+19
* - add get_info_from_fstab()Pascal Rigaux2003-02-271-3/+2
* have locales-xx first in default_packages so that default choosing based onPascal Rigaux2003-02-271-2/+2
* to workaround perl bug removing UTF8 flag when passing scalars to die's, passGuillaume Cottenceau2003-02-191-3/+3
='#n606'>606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768
package authentication; # $Id$

use common;

my $lib = arch() =~ /x86_64/ ? 'lib64' : 'lib';

sub kinds { 
    my $no_para = @_ == 0;
    my ($do_pkgs) = @_;
    my $allow_SmartCard = $no_para || $do_pkgs->is_available('castella-pam');
    my $allow_AD = 1;
    (
	'local', 
	'LDAP',
	'NIS', 
	if_($allow_SmartCard, 'SmartCard'), 
	'winbind', 
	if_($allow_AD, 'AD', 'SMBKRB'),
    );
}

sub kind2name {
    my ($kind) = @_;
    # Keep the following strings in sync with kind2description ones!!!
    ${{ local => N("Local file"), 
    LDAP => N("LDAP"), 
    NIS => N("NIS"),
    SmartCard => N("Smart Card"),
    winbind => N("Windows Domain"), 
    AD => N("Active Directory with SFU"),
    SMBKRB => N("Active Directory with Winbind") }}{$kind};
}

my %kind2pam_kind = (
    local     => [],
    SmartCard => ['castella'],
    LDAP      => ['ldap'], 
    NIS       => [],
    AD        => ['krb5'],
    winbind   => ['winbind'], 
    SMBKRB    => ['winbind'],
);

my %kind2nsswitch = (
    local     => [],
    SmartCard => [],
    LDAP      => ['ldap'], 
    NIS       => ['nis'],
    AD        => ['ldap'],
    winbind   => ['winbind'], 
    SMBKRB    => ['winbind'],
);

my %kind2packages = (
    local     => [],
    SmartCard => [ 'castella-pam' ],
    LDAP      => [ 'openldap-clients', 'nss_ldap', 'pam_ldap', 'autofs' ],
    AD        => [ 'nss_ldap', 'pam_krb5', $lib . 'sasl2-plug-gssapi' ],
    NIS       => [ 'ypbind', 'autofs' ],
    winbind   => [ 'samba-winbind' ],
    SMBKRB    => [ 'samba-winbind', 'pam_krb5', 'samba-server', 'samba-client' ],
);


sub kind2description {
    my (@kinds) = @_;
    my %kind2description = (
	local     => [ N("Local file:"), N("Use information stored in local files for all authentication"), ],
	LDAP      => [ N("LDAP:"), N("Tells your computer to use LDAP for some or all authentication. LDAP consolidates certain types of information within your organization."), ],
	NIS       => [ N("NIS:"), N("Allows you to run a group of computers in the same Network Information Service domain with a common password and group file."), ],
	winbind   => [ N("Windows Domain:"), N("Winbind allows the system to retrieve information and authenticate users in a Windows domain."), ],
	AD        => [ N("Active Directory with SFU:"), N("With Kerberos and Ldap for authentication in Active Directory Server "), ],
	SMBKRB    => [ N("Active Directory with Winbind:"), N("Winbind allows the system to authenticate users in a Windows Active Directory Server.")  ],
    );
    join('', map { $_ ? qq($_->[0]\n$_->[1]\n\n) : '' } map { $kind2description{$_} } @kinds);
}
sub to_kind {
    my ($authentication) = @_;
    (find { exists $authentication->{$_} } kinds()) || 'local';
}

sub domain_to_ldap_domain {
    my ($domain) = @_;
    join(',', map { "dc=$_" } split /\./, $domain);
}

sub ask_parameters {
    my ($in, $net, $authentication, $kind) = @_;

    #- keep only this authentication kind
    foreach (kinds()) {
	delete $authentication->{$_} if $_ ne $kind;
    }

    if ($kind eq 'LDAP') {
	$authentication->{LDAPDOMAIN} ||= domain_to_ldap_domain($net->{resolv}{DOMAINNAME});
	$in->ask_from('',
		     N("Authentication LDAP"),
		     [ { label => N("LDAP Base dn"), val => \$authentication->{LDAPDOMAIN} },
		       { label => N("LDAP Server"), val => \$authentication->{LDAP_server} },
		     ]) or return;
    } elsif ($kind eq 'AD') {
	
	$authentication->{AD_domain} ||= $net->{resolv}{DOMAINNAME};
	$authentication->{AD_users_db} ||= 'cn=users,' . domain_to_ldap_domain($authentication->{AD_domain});

	$in->do_pkgs->ensure_are_installed([ 'perl-Net-DNS' ], 1) or return;

	my @srvs = query_srv_names($authentication->{AD_domain});
	$authentication->{AD_server} ||= $srvs[0] if @srvs;

	my %sub_kinds = (
	    simple => N("simple"), 
	    tls => N("TLS"),
	    ssl => N("SSL"),
	    kerberos => N("security layout (SASL/Kerberos)"),
	);

	my $AD_user = $authentication->{AD_user} =~ /(.*)\@\Q$authentication->{AD_domain}\E$/ ? $1 : $authentication->{AD_user};
	my $anonymous = $AD_user;

	$in->ask_from('',
		     N("Authentication Active Directory"),
		     [ { label => N("Domain"), val => \$authentication->{AD_domain} },
		     #{ label => N("Server"), val => \$authentication->{AD_server} },
		       { label => N("Server"), type => 'combo', val => \$authentication->{AD_server}, list => \@srvs , not_edit => 0 },
		       { label => N("LDAP users database"), val => \$authentication->{AD_users_db} },
		       { label => N("Use Anonymous BIND "), val => \$anonymous, type => 'bool' },
		       { label => N("LDAP user allowed to browse the Active Directory"), val => \$AD_user, disabled => sub { $anonymous } },
		       { label => N("Password for user"), val => \$authentication->{AD_password}, hidden => 1, disabled => sub { $anonymous } },
		       #{ label => N("Encryption"), val => \$authentication->{sub_kind}, list => [ map { $_->[0] } group_by2(@sub_kinds) ], format => sub { $sub_kinds{$_[0]} } },
		     ]) or return;
	$authentication->{AD_user} = !$AD_user || $authentication->{sub_kind} eq 'anonymous' ? '' : 
	                             $AD_user =~ /@/ ? $AD_user : "$AD_user\@$authentication->{AD_domain}";
	$authentication->{AD_password} = '' if !$authentication->{AD_user};


    } elsif ($kind eq 'NIS') { 
	$authentication->{NIS_server} ||= 'broadcast';
	$net->{network}{NISDOMAIN} ||= $net->{resolv}{DOMAINNAME};
	$in->ask_from('',
		     N("Authentication NIS"),
		     [ { label => N("NIS Domain"), val => \$net->{network}{NISDOMAIN} },
		       { label => N("NIS Server"), val => \$authentication->{NIS_server}, list => ["broadcast"], not_edit => 0 },
		     ]) or return;
    } elsif ($kind eq 'winbind' || $kind eq 'SMBKRB') {
	#- maybe we should browse the network like diskdrake --smb and get the 'doze server names in a list 
	#- but networking is not setup yet necessarily
	$in->ask_warn('', N("For this to work for a W2K PDC, you will probably need to have the admin run: C:\\>net localgroup \"Pre-Windows 2000 Compatible Access\" everyone /add and reboot the server.
You will also need the username/password of a Domain Admin to join the machine to the Windows(TM) domain.
If networking is not yet enabled, Drakx will attempt to join the domain after the network setup step.
Should this setup fail for some reason and domain authentication is not working, run 'smbpasswd -j DOMAIN -U USER%%PASSWORD' using your Windows(tm) Domain, and Admin Username/Password, after system boot.
The command 'wbinfo -t' will test whether your authentication secrets are good."))
	  if $kind eq 'winbind';

	$authentication->{AD_domain} ||= $net->{resolv}{DOMAINNAME} if $kind eq 'SMBKRB';
	 $authentication->{AD_users_idmap} ||= 'ou=idmap,' . domain_to_ldap_domain($authentication->{AD_domain}) if $kind eq 'SMBKRB';
	$authentication->{WINDOMAIN} ||= $net->{resolv}{DOMAINNAME};

	$in->ask_from('',
		      $kind eq 'SMBKRB' ? N("Authentication Active Directory") : N("Authentication Windows Domain"),
		        [ if_($kind eq 'SMBKRB', 
			  { label => N("Active Directory Realm "), val => \$authentication->{AD_domain} }
			     ),
			  { label => N("Windows Domain"), val => \$authentication->{WINDOMAIN} },
			  { label => N("Domain Admin User Name"), val => \$authentication->{winuser} },
			  { label => N("Domain Admin Password"), val => \$authentication->{winpass}, hidden => 1 },
			  #{ label => N("Use Idmap for store UID/SID "), val => \$anonymous, type => 'bool' },
			  #{ label => N("Default Idmap "), val => \$authentication->{AD_users_idmap}, disabled => sub { $anonymous } },
			]) or return;
    }
    $authentication->{$kind} ||= 1;
    1;
}

sub ask_root_password_and_authentication {
    my ($in, $net, $superuser, $authentication, $_meta_class, $security) = @_;

    my $kind = to_kind($authentication);
    my @kinds = kinds($in->do_pkgs);

    $in->ask_from_({
	 title => N("Authentication"), 
	 messages => N("Set administrator (root) password"),
	 icon => 'banner-pw',
	 advanced_label => N("Authentication method"),
	 advanced_messages => kind2description(@kinds),
	 interactive_help_id => "setRootPassword",
	 cancel => ($security <= 2 ? 
		    #-PO: keep this short or else the buttons will not fit in the window
		    N("No password") : ''),
	 focus_first => 1,
	 callbacks => { 
	     complete => sub {
		 check_given_password($in, $superuser, 2 * $security) or return 1,0;
		 return 0;
        } } }, [
{ label => N("Password"), val => \$superuser->{password},  hidden => 1 },
{ label => N("Password (again)"), val => \$superuser->{password2}, hidden => 1 },
{ label => N("Authentication"), val => \$kind, type => 'list', list => \@kinds, format => \&kind2name, advanced => 1 },
        ]) or delete $superuser->{password};

    ask_parameters($in, $net, $authentication, $kind) or goto &ask_root_password_and_authentication;
}

sub check_given_password {
    my ($in, $u, $min_length) = @_;
    if ($u->{password} ne $u->{password2}) {
	$in->ask_warn('', [ N("The passwords do not match"), N("Please try again") ]);
	0;
    } elsif (length $u->{password} < $min_length) {
	$in->ask_warn('', N("This password is too short (it must be at least %d characters long)", $min_length));
	0;
    } else {
	1;
    }
}

sub get() {
    my $system_auth = cat_("/etc/pam.d/system-auth");
    my $authentication = { 
	md5 => $system_auth =~ /md5/, shadow => $system_auth =~ /shadow/, 
    };

    my @pam_kinds = get_pam_authentication_kinds();
    if (my $kind = find { intersection(\@pam_kinds, $kind2pam_kind{$_}) } keys %kind2pam_kind) {
	$authentication->{$kind} = '';
    } else {
	#- we can't use pam to detect NIS
	if (my $yp_conf = read_yp_conf()) {
	    $authentication->{NIS} = 1;
	    map_each { $authentication->{"NIS_$::a"} = $::b } %$yp_conf;
	}
    }
    $authentication;
}

sub install_needed_packages {
    my ($do_pkgs, $kind) = @_;
    if (my $pkgs = $kind2packages{$kind}) {
	#- automatic during install
	$do_pkgs->ensure_are_installed($pkgs, $::isInstall) or return;
    } else {
	log::l("ERROR: $kind not listed in kind2packages");
    }
    1;
}

sub set {
    my ($in, $net, $authentication, $o_when_network_is_up) = @_;

    install_needed_packages($in->do_pkgs, to_kind($authentication)) or return;
    set_raw($net, $authentication, $o_when_network_is_up);
}

sub set_raw {
    my ($net, $authentication, $o_when_network_is_up) = @_;

    my $when_network_is_up = $o_when_network_is_up || sub { my ($f) = @_; $f->() };

    enable_shadow() if $authentication->{shadow};    

    my $kind = to_kind($authentication);

    log::l("authentication::set $kind");

    my $pam_modules = $kind2pam_kind{$kind} or log::l("kind2pam_kind does not know $kind");
    $pam_modules ||= [];
    sshd_config_UsePAM(@$pam_modules > 0);
    set_pam_authentication(@$pam_modules);

    my $nsswitch = $kind2nsswitch{$kind} or log::l("kind2nsswitch does not know $kind");
    $nsswitch ||= [];
    set_nsswitch_priority(@$nsswitch);

    if ($kind eq 'local') {
    } elsif ($kind eq 'SmartCard') {
    } elsif ($kind eq 'LDAP') {
	my $domain = $authentication->{LDAPDOMAIN} || do {
	    my $s = run_program::rooted_get_stdout($::prefix, 'ldapsearch', '-x', '-h', $authentication->{LDAP_server}, '-b', '', '-s', 'base', '+');
	    first($s =~ /namingContexts: (.+)/);
	} or log::l("no ldap domain found on server $authentication->{LDAP_server}"), return;

	update_ldap_conf(
			 host => $authentication->{LDAP_server},
			 base => $domain,
			 nss_base_shadow => $domain . "?sub",
			 nss_base_passwd => $domain . "?sub",
			 nss_base_group => $domain . "?sub",
			);
    } elsif ($kind eq 'AD') {
	my $port = "389";
	
	my $ssl = { 
		   anonymous => 'off', 
		   simple => 'off', 
		   tls => 'start_tls',
		   ssl => 'on',
		   kerberos => 'off',
		  }->{$authentication->{sub_kind}};

	if ($ssl eq 'on') {
		$port = '636';
	}
	
	
	
	update_ldap_conf(
			 host => $authentication->{AD_server},
			 base => domain_to_ldap_domain($authentication->{AD_domain}),
			 nss_base_shadow => "$authentication->{AD_users_db}?sub",
			 nss_base_passwd => "$authentication->{AD_users_db}?sub",
			 nss_base_group => "$authentication->{AD_users_db}?sub",

			 ssl => $ssl,
			 sasl_mech => $authentication->{sub_kind} eq 'kerberos' ? 'GSSAPI' : '',
			 port => $port,

			 binddn => $authentication->{AD_user},
			 bindpw => $authentication->{AD_password},

			 (map_each { "nss_map_objectclass_$::a" => $::b }
			  posixAccount => 'User',
			  shadowAccount => 'User',
			  posixGroup => 'Group',
			 ),


			 scope => 'sub',
			 pam_login_attribute => 'sAMAccountName',
			 pam_filter => 'objectclass=User',
			 pam_password => 'ad',

			 
			 (map_each { "nss_map_attribute_$::a" => $::b }
			  uid => 'sAMAccountName',
			  uidNumber => 'msSFU30UidNumber',
			  gidNumber => 'msSFU30GidNumber',
			  cn => 'sAMAccountName',
			  uniqueMember => 'member',
			  userPassword => 'msSFU30Password',
			  homeDirectory => 'msSFU30HomeDirectory',
			  loginShell => 'msSFU30LoginShell',
			  gecos => 'name',
			 ),
			);

	configure_krb5_for_AD($authentication);

    } elsif ($kind eq 'NIS') {
	my $domain = $net->{network}{NISDOMAIN};
	my $NIS_server = $authentication->{NIS_server};
	$domain || $NIS_server ne "broadcast" or die N("Can not use broadcast with no NIS domain");
	my $t = $domain ? 
	  ($NIS_server eq 'broadcast' ? 
	     "domain $domain broadcast" : 
	     "domain $domain server $NIS_server") :
	     "server $NIS_server";

	substInFile {
	    if (/^#/) {
		$_ = '' if /^#\Q[PREVIOUS]/;
	    } else {
		$_ = "#[PREVIOUS] $_";
	    }
	    $_ .= "$t\n" if eof;
	} "$::prefix/etc/yp.conf";

	#- no need to modify system-auth for nis

	$when_network_is_up->(sub {
	    run_program::rooted($::prefix, 'nisdomainname', $domain);
	    run_program::rooted($::prefix, 'service', 'ypbind', 'restart');
	});
#    } elsif ($kind eq 'winbind' || $kind eq 'AD' && $authentication->{subkind} eq 'winbind') {

    } elsif ($kind eq 'winbind') {

	my $domain = uc $authentication->{WINDOMAIN};
	
	require fs::remote::smb;
	fs::remote::smb::write_smb_conf($domain);
	run_program::rooted($::prefix, "chkconfig", "--level", "35", "winbind", "on");
	mkdir_p("$::prefix/home/$domain");
	run_program::rooted($::prefix, 'service', 'smb', 'restart');
	run_program::rooted($::prefix, 'service', 'winbind', 'restart');
	
	#- defer running smbpassword until the network is up

	$when_network_is_up->(sub {
	    run_program::raw({ root => $::prefix, sensitive_arguments => 1 },
			     'net', 'join', $domain, '-U', $authentication->{winuser} . '%' . $authentication->{winpass});
	});
    } elsif ($kind eq 'SMBKRB') {
	 $authentication->{AD_server} ||= 'ads.' . $authentication->{AD_domain};
	my $domain = uc $authentication->{WINDOMAIN};
	my $realm = $authentication->{AD_domain};

	configure_krb5_for_AD($authentication);
		
	require fs::remote::smb;
	fs::remote::smb::write_smb_ads_conf($domain,$realm);
	run_program::rooted($::prefix, "chkconfig", "--level", "35", "winbind", "on");
	mkdir_p("$::prefix/home/$domain");
	run_program::rooted($::prefix, 'net', 'time', 'set', '-S', $authentication->{AD_server});
	run_program::rooted($::prefix, 'service', 'smb', 'restart');
	run_program::rooted($::prefix, 'service', 'winbind', 'restart');
	
	$when_network_is_up->(sub {
	    run_program::raw({ root => $::prefix, sensitive_arguments => 1 }, 
			     'net', 'ads', 'join', '-U', $authentication->{winuser} . '%' . $authentication->{winpass});
	});
    }
    1;
}


sub pam_modules() {
    'pam_ldap', 'pam_castella', 'pam_winbind', 'pam_krb5', 'pam_mkhomedir';
}
sub pam_module_from_path { 
    $_[0] && $_[0] =~ m|(/lib/security/)?(pam_.*)\.so| && $2;
}
sub pam_module_to_path { 
    "$_[0].so";
}
sub pam_format_line {
    my ($type, $control, $module, @para) = @_;
    sprintf("%-11s %-13s %s\n", $type, $control, join(' ', pam_module_to_path($module), @para));
}

sub get_raw_pam_authentication() {
    my %before_deny;
    foreach (cat_("$::prefix/etc/pam.d/system-auth")) {
	my ($type, $control, $module, @para) = split;
	if ($module = pam_module_from_path($module)) {
	    $before_deny{$type}{$module} = \@para if $control eq 'sufficient' && member($module, pam_modules());
	}
    }
    \%before_deny;
}

sub get_pam_authentication_kinds() {
    my $before_deny = get_raw_pam_authentication();
    map { s/pam_//; $_ } keys %{$before_deny->{auth}};
}

sub set_pam_authentication {
    my (@authentication_kinds) = @_;
    
    my %special = (
	auth => [ difference2(\@authentication_kinds,, [ 'mount' ]) ],
	account => [ difference2(\@authentication_kinds, [ 'castella', 'mount' ]) ],
	password => [ intersection(\@authentication_kinds, [ 'ldap', 'krb5' ]) ],
    );
    my %before_first = (
	auth => member('mount', @authentication_kinds) ? pam_format_line('auth', 'required', 'pam_mount') : '',
	session => 
	  intersection(\@authentication_kinds, [ 'winbind', 'krb5', 'ldap' ]) 
	    ? pam_format_line('session', 'optional', 'pam_mkhomedir', 'skel=/etc/skel/', 'umask=0022') :
	  member('castella', @authentication_kinds)
	    ? pam_format_line('session', 'optional', 'pam_castella') : '',
    );
    my %after_deny = (
	session =>
          member('krb5', @authentication_kinds)
            ? pam_format_line('session', 'optional', 'pam_krb5') :
          member('mount', @authentication_kinds)
            ? pam_format_line('session', 'optional', 'pam_mount') : '',
    );

    substInFile {
	my ($type, $control, $module, @para) = split;
	if ($module = pam_module_from_path($module)) {
	    if (member($module, pam_modules())) {
		#- first removing previous config
		$_ = '';
	    }
	    if ($module eq 'pam_unix' && $special{$type}) {
		my @para_for_last = 
		    member($type, 'auth', 'account') ? qw(use_first_pass) : @{[]};
		@para = difference2(\@para, \@para_for_last);

		my ($before_noask, $ask) = partition { $_ eq 'castella' } @{$special{$type}};
		my ($before, $after) = partition { $_ eq 'krb5' } @$ask;

		if (!@$ask) {
		    @para_for_last = grep { $_ ne 'use_first_pass' } @para_for_last;
		}

		my @l = ((map { [ "pam_$_" ] } @$before_noask, @$before),
			 [ 'pam_unix', @para ],
			 (map { [ "pam_$_" ] } @$after),
			 );
		push @{$l[-1]}, @para_for_last;
		$_ = join('', map { pam_format_line($type, 'sufficient', @$_) } @l);

		if ($control eq 'required') {
		    #- ensure a pam_deny line is there
		    ($control, $module, @para) = ('required', 'pam_deny');
		    $_ .= pam_format_line($type, $control, $module);
		}
	    }
	    if (my $s = delete $before_first{$type}) {
		$_ = $s . $_;
	    }
	    if ($control eq 'required' && member($module, 'pam_deny', 'pam_unix')) {
		if (my $s = delete $after_deny{$type}) {
		    $_ .= $s;
		}
	    }
	}
    } "$::prefix/etc/pam.d/system-auth";
}

sub set_nsswitch_priority {
    my (@kinds) = @_;
    my @known = qw(nis ldap winbind);
    substInFile {
	if (my ($database, $l) = /^(\s*(?:passwd|shadow|group|automount):\s*)(.*)/) {
	    my @l = difference2([ split(' ', $l) ], \@known);
	    $_ = $database . join(' ', uniq('files', @kinds, @l)) . "\n";
	}	
    } "$::prefix/etc/nsswitch.conf";
}

sub read_yp_conf() {
    my $yp_conf = cat_("$::prefix/etc/yp.conf");
    
    if ($yp_conf =~ /^domain\s+(\S+)\s+(\S+)\s*(.*)/m) {
	{ domain => $1, server => $2 eq 'broadcast' ? 'broadcast' : $3 };
    } elsif ($yp_conf =~ /^server\s+(.*)/m) {
	{ server => $1 };
    } else {
	undef;
    }    
}

my $special_ldap_cmds = join('|', 'nss_map_attribute', 'nss_map_objectclass');
sub _after_read_ldap_line {
    my ($s) = @_;
    $s =~ s/\b($special_ldap_cmds)\s*/$1 . '_'/e;
    $s;
}
sub _pre_write_ldap_line {
    my ($s) = @_;
    $s =~ s/\b($special_ldap_cmds)_/$1 . ' '/e;
    $s;
}

sub read_ldap_conf() {
    my %conf = map { 
	s/^\s*#.*//; 
	if_(_after_read_ldap_line($_) =~ /(\S+)\s+(.*)/, $1 => $2);
    } cat_("$::prefix/etc/ldap.conf");
    \%conf;
}

sub update_ldap_conf {    
    my (%conf) = @_;

    substInFile {
	my ($cmd) = _after_read_ldap_line($_) =~ /^\s*#?\s*(\w+)\s/;
	if ($cmd && exists $conf{$cmd}) {
	    my $val = $conf{$cmd};
	    $conf{$cmd} = '';
	    $_ = $val ? _pre_write_ldap_line("$cmd $val\n") : /^\s*#/ ? $_ : "#$_";
        }
	if (eof) {
	    foreach my $cmd (keys %conf) {
		my $val = $conf{$cmd} or next;
		$_ .= _pre_write_ldap_line("$cmd $val\n");
	    }
	}
    } "$::prefix/etc/ldap.conf";
}

sub configure_krb5_for_AD {
    my ($authentication) = @_;

    my $uc_domain = uc $authentication->{AD_domain};
    my $krb5_conf_file = "$::prefix/etc/krb5.conf";

    krb5_conf_update($krb5_conf_file,
		     libdefaults => (
				     default_realm => $uc_domain,
				     dns_lookup_realm => $authentication->{AD_server} ? 'false' : 'true',
				     dns_lookup_kdc => $authentication->{AD_server} ? 'false' : 'true',
				     default_tgs_enctypes => undef, 
				     default_tkt_enctypes => undef,
				     permitted_enctypes => undef,
				    ));

    my @sections = (
		    realms => <<EOF,
 $uc_domain = {
  kdc = $authentication->{AD_server}:88
  admin_server = $authentication->{AD_server}:749
  default_domain = $authentication->{AD_domain}
 }
EOF
		    domain_realm => <<EOF,
 .$authentication->{AD_domain} = $uc_domain
EOF
		    kdc => <<'EOF',
 profile = /etc/kerberos/krb5kdc/kdc.conf
EOF
		    pam => <<'EOF',
 debug = false
 ticket_lifetime = 36000
 renew_lifetime = 36000
 forwardable = true
 krb4_convert = false
EOF
		    login => <<'EOF',
 krb4_convert = false
 krb4_get_tickets = false
EOF
		       );
    foreach (group_by2(@sections)) {
	my ($section, $txt) = @$_;
	krb5_conf_overwrite_category($krb5_conf_file, $section => $authentication->{AD_server} ? $txt : '');
    }
}

sub krb5_conf_overwrite_category {
    my ($file, $category, $new_val) = @_;

    my $done;
    substInFile {
	if (my $i = /^\s*\[\Q$category\E\]/i ... /^\[/) {
	    if ($new_val) {
		if ($i == 1) {
		    $_ .= $new_val;
		    $done = 1;
		} elsif ($i =~ /E/) {
		    $_ = "\n$_";
		} else {
		    $_ = '';
		}
	    } else {
		$_ = '' if $i !~ /E/;
	    }
	}
	#- if category has not been found above.
	if (eof && $new_val && !$done) {
	    $_ .= "\n[$category]\n$new_val";
	}
    } $file;
}

#- same as update_gnomekderc(), but allow spaces around "="
sub krb5_conf_update {
    my ($file, $category, %subst_) = @_;

    my %subst = map { lc($_) => [ $_, $subst_{$_} ] } keys %subst_;

    my $s;
    foreach (MDK::Common::File::cat_($file), "[NOCATEGORY]\n") {
	if (my $i = /^\s*\[\Q$category\E\]/i ... /^\[/) {
	    if ($i =~ /E/) { #- for last line of category
		chomp $s; $s .= "\n";
		$s .= " $_->[0] = $_->[1]\n" foreach grep { defined($_->[1]) } values %subst;
		%subst = ();
	    } elsif (/^\s*([^=]*?)\s*=/) {
		if (my $e = delete $subst{lc($1)}) {
		    $_ = defined($e->[1]) ? " $1 = $e->[1]\n" : '';
		}
	      }
	}
	$s .= $_ if !/^\Q[NOCATEGORY]/;
    }

    #- if category has not been found above.
    if (keys %subst) {
	chomp $s;
	$s .= "\n[$category]\n";
	$s .= " $_->[0] = $_->[1]\n" foreach grep { defined($_->[1]) } values %subst;
    }

    MDK::Common::File::output($file, $s);

}

sub sshd_config_UsePAM {
    my ($UsePAM) = @_;
    my $sshd = "$::prefix/etc/ssh/sshd_config";
    -e $sshd or return;

    my $val = "UsePAM " . bool2yesno($UsePAM);
    substInFile {
	$val = '' if s/^#?UsePAM.*/$val/;
	$_ .= "$val\n" if eof && $val;
    } $sshd;
}

sub query_srv_names {
    my ($domain) = @_;

    eval { require Net::DNS; 1 } or return;
    my $res = Net::DNS::Resolver->new;
    my $query = $res->query("_ldap._tcp.$domain", 'srv') or return;
    map { $_->target } $query->answer;
}

sub enable_shadow() {
    run_program::rooted($::prefix, "pwconv")  or log::l("pwconv failed");
    run_program::rooted($::prefix, "grpconv") or log::l("grpconv failed");
}

sub salt {
    my ($nb) = @_;
    require devices;
    open(my $F, devices::make("random")) or die "missing random";
    my $s; read $F, $s, $nb;
    $s = pack("b8" x $nb, unpack "b6" x $nb, $s);
    $s =~ tr|\0-\x3f|0-9a-zA-Z./|;
    $s;
}

sub user_crypted_passwd {
    my ($u, $isMD5) = @_;
    if ($u->{password}) {
	crypt($u->{password}, $isMD5 ? '$1$' . salt(8) : salt(2));
    } else {
	$u->{pw} || '';
    }
}

sub set_root_passwd {
    my ($superuser, $authentication) = @_;
    $superuser->{name} = 'root';
    write_passwd_user($superuser, $authentication->{md5});    
    delete $superuser->{name};
}

sub write_passwd_user {
    my ($u, $isMD5) = @_;

    $u->{pw} = user_crypted_passwd($u, $isMD5);      
    $u->{shell} ||= '/bin/bash';

    substInFile {
	my $l = unpack_passwd($_);
	if ($l->{name} eq $u->{name}) {
	    add2hash_($u, $l);
	    $_ = pack_passwd($u);
	    $u = {};
	}
	if (eof && $u->{name}) {
	    $_ .= pack_passwd($u);
	}
    } "$::prefix/etc/passwd";
}

my @etc_pass_fields = qw(name pw uid gid realname home shell);
sub unpack_passwd {
    my ($l) = @_;
    my %l; @l{@etc_pass_fields} = split ':', chomp_($l);
    \%l;
}
sub pack_passwd {
    my ($l) = @_;
    join(':', @$l{@etc_pass_fields}) . "\n";
}

1;