#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use XML::Parser;
use File::Temp qw/tempfile/;

my ($x,$y);
our %params;
our %schemas;
our $hostname;
our @fstab=();
our %fstypes=(	'swap'	=>['mkswap'],
		'xfs'	=>['mkfs.xfs'],
		'ext2'	=>['mke2fs'],
		'ext3'	=>['mke2fs','-j']);

sub mytrim ($) {
	my $x=shift;
	$x=~ s/^\s*\n(\s*?\S)/$1/s;
	$x=~ s/(\S\s*?\n)\s+$/$1/s;
	$x=~ s/^\s*$//s;
	return $x;
}

sub mydebug($$@) {
	my $line=shift;
	my $caller=shift;
	my $msg=join('',@_);
	if (defined($params{debug}) and $params{debug}) {
		print "DEBUG(".join(',',__FILE__,$line,$caller)."):".$msg."\n";
	}
}

sub mywarn($$@) {
	my $line=shift;
	my $caller=shift;
	my $msg=join('',@_);
	print "WARNING(".join(',',__FILE__,$line,$caller)."):".$msg."\n"
		unless (defined($params{quiet}) and $params{quiet});
}

sub trymkdir($);
sub trymkdir ($) {
	my $dir=shift;
	my $pdir=$dir;
	$pdir=~s/[^\/]+\/*$//;
	mydebug(__LINE__,'trymkdir',$dir);
	if (-d $dir) {
		return 1;
	} elsif (-d $pdir) {
		return mkdir $dir;
	} else {
		trymkdir($pdir);
		return mkdir $dir;
	}
}

sub myproc ($) {
	my $arg=shift;
	my $node=shift @{$arg};
	my %attrs;
	%params=();
	if ( $node eq "installer" ) {
		$arg=shift @{$arg};
		%attrs=%{shift @{$arg}};
		foreach my $key (keys(%attrs)) {
			print "\t".$key.":".$attrs{$key}."\n";
			$params{$key}=$attrs{$key};
		}
		while(defined($node=shift @{$arg})) {
			if(not $node) {
				print mytrim(shift @{$arg});
			} elsif ($node eq "machine") {
				myproc_machine(shift @{$arg});
			} elsif ($node eq "schema") {
				myproc_schema(shift @{$arg});
			} else {
				print __FILE__.",".__LINE__.": unknown tag";
			}
		}
	} else {
		mywarn(__FILE__,__LINE__,"myproc","Not an installer file");
	}
}

sub nochild ($$) {
	my $name=shift;
	my $arg=shift;
	my $node;
	while (defined($node=shift @{$arg})) {
		if (not $node) {
			print mytrim(shift @{$arg});
		} else {
			mywarn(__LINE__,'nochild',$name," node shouldn't contain child node!");
			shift @{$arg};
		}
	}
}

sub runcmdvty (@) {
	my $cmd=join(' ',@_);
	my @cmd;
	my $ret;
	
	if (defined($params{installvty}) and $params{installvty}) {
		@cmd=('openvt');
		push @cmd,'-c',$params{installvty};
		push @cmd,'-s';
		if (defined($params{forcevt}) and $params{forcevt} ) {
			push @cmd,'-f';
		}
		push @cmd,'-w','--';
	}
	if (defined($params{chroot})) {
		push @cmd,"chroot",$params{chroot};
	}
	push @cmd,$cmd;
	mydebug(__LINE__,'runcmdvty',join(' ',@cmd));
	$ret=system(join(' ',@cmd));
	if (defined($params{msgvty}) and $params{msgvty} ) {
		system('chvt '.$params{msgvty});
	}
	return $ret;
}

sub runcmdinput ($@) {
	my $input=shift;
	my @rcmd=@_;
	my @cmd;
	my $ret;
	if (defined($params{chroot})) {
		push @cmd,"chroot",$params{chroot};
	} 
	push @cmd,@rcmd;
	mydebug(__LINE__,'runcmdinput','|',join(' ',@cmd));
	my $pid=open F, "|-",@cmd;
	print F $input;
	close F;
	return waitpid $pid,0;
}

sub myproc_schema ($) {
	my $arg=shift;
	my %attrs=%{shift @{$arg}};
	if(defined($attrs{name})) {
		$schemas{$attrs{name}}=$arg;
	} else {
		mywarn(__LINE__,'myproc_schema',"unknown schema name");
	}
}

sub myproc_machine ($) {
	my $arg=shift;
	my $node;
	my %attrs=%{shift @{$arg}};
	if(!defined($attrs{hostname})){
		mywarn(__LINE__,'myproc_machine',"missing hostname attribute");
		return 0;
	}
	if($attrs{hostname} eq $hostname) {
		runcmdvty('hostname',$attrs{hostname});
	} else {
		return 1;
	}
	foreach my $key (keys(%attrs)) {
		print "\t".$key.":".$attrs{$key}."\n";
		$params{$key}=$attrs{$key};
	}
	while (defined($node= shift @{$arg})) {
		if (not $node) {
			print mytrim(shift @{$arg});
		} elsif ($node eq 'disk') {
			myproc_machine_disk(shift @{$arg},\%attrs);
		} elsif ($node eq 'raid') {
			myproc_machine_raid(shift @{$arg},\%attrs);
		} elsif ($node eq 'pv') {
			myproc_machine_pv(shift @{$arg},\%attrs);
		} elsif ($node eq 'vg') {
			myproc_machine_vg(shift @{$arg},\%attrs);
		} elsif ($node eq 'lv') {
			myproc_machine_lv(shift @{$arg},\%attrs);
		} elsif ($node eq 'fs') {
			myproc_machine_fs(shift @{$arg},\%attrs);
		} elsif ($node eq 'debootstrap') {
			myproc_machine_debootstrap(shift @{$arg},\%attrs);
		} elsif ($node eq 'debconf') {
			myproc_machine_debconf(shift @{$arg},\%attrs);
		} elsif ($node eq 'kernel') {
			myproc_machine_kernel(shift @{$arg},\%attrs);
		} elsif ($node eq 'aptkey') {
			myproc_machine_aptkey(shift @{$arg},\%attrs);
		} elsif ($node eq 'aptsource') {
			myproc_machine_aptsource(shift @{$arg},\%attrs);
		} elsif ($node eq 'user') {
			myproc_machine_user(shift @{$arg},\%attrs);
		} elsif ($node eq 'group') {
			myproc_machine_group(shift @{$arg},\%attrs);
		} elsif ($node eq 'patch') {
			myproc_machine_patch(shift @{$arg},\%attrs);
		} elsif ($node eq 'aptinst') {
			myproc_machine_aptinst(shift @{$arg},\%attrs);
		} elsif ($node eq 'textfile' ) {
			myproc_machine_textfile(shift @{$arg},\%attrs);
		} elsif ($node eq 'dir' ) {
			myproc_machine_dir(shift @{$arg},\%attrs);
		} elsif ($node eq 'schema' ) {
			my $sname=
			myproc_machine_schema(shift @{$arg},\%attrs);
			@{$arg}=(@{$schemas{$sname}},@{$arg}) if(defined($sname)) ;
		} elsif ($node eq 'script' ) {
			myproc_machine_script(shift @{$arg},\%attrs);
		} else {
			print $node.":".mytrim(shift @{$arg})."\n";
		}
	}
}

sub myproc_machine_schema($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $node;
	if (!defined($attrs{name})) {
		mywarn(__LINE__,'myproc_machine_schema',"Missing name attribute!");
		return undef;
	}
	nochild("Cmn",$arg);
	return $attrs{name};
}

sub myproc_machine_disk ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $node;
	if (!defined($attrs{dev})) {
		mywarn(__LINE__,'myproc_machine_disk',"Missing dev attribute!");
		return;
	}
	while (defined($node= shift @{$arg})) {
		if (not $node) {
			print mytrim(shift @{$arg});
		} elsif ($node eq 'label') {
			myproc_machine_disk_label(shift @{$arg},\%attrs);
		} elsif ($node eq 'part') {
			myproc_machine_disk_part(shift @{$arg},\%attrs);
		} elsif ($node eq 'flag') {
			myproc_machine_disk_flag(shift @{$arg},\%attrs);
		} else {
			mywarn(__LINE__,'myproc_machine_disk',"unknown child node '".mytrim(shift @{$arg})."'");
		}
	}
}

sub myproc_machine_disk_label ($$) {
	my $arg=shift;
	my $pattrs=shift;
	my %attrs=%{shift @{$arg}};
	my $node;
	if (!defined($attrs{type})) {
		mywarn(__LINE__,'myproc_machine_disk_label',"Missing type attribute!");
		return;
	} else {
		runcmdvty('parted','-s',$pattrs->{dev},'mklabel',$attrs{type});
	}
	nochild("Disklabel",$arg);
}

sub myproc_machine_disk_part ($$) {
	my $arg=shift;
	my $pattrs=shift;
	my %attrs=%{shift @{$arg}};
	my $node;
	if (defined($attrs{type}) and defined($attrs{begin}) and defined($attrs{end})) {
		runcmdvty('parted','-s',$pattrs->{dev},'mkpart',$attrs{type},$attrs{begin},$attrs{end});
	} else {
		mywarn(__LINE__,'myproc_machine_disk_part',"Missing type,begin or end attribute!");
		return;
	}
	nochild("DiskPart",$arg);
}

sub myproc_machine_disk_flag ($$) {
	my $arg=shift;
	my $pattrs=shift;
	my %attrs=%{shift @{$arg}};
	my $node;
	if (defined($attrs{id}) and defined($attrs{name}) and defined($attrs{value})) {
		runcmdvty('parted','-s',$pattrs->{dev},'set',$attrs{id},$attrs{name},$attrs{value});
	} else {
		mywarn(__LINE__,'myproc_machine_disk_flag',"Missing id,name or value attribute!");
		return;
	}
	nochild("Diskflag",$arg);
}

sub myproc_machine_raid ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $node;
	my @cdevs;
	if (defined($attrs{dev}) and defined($attrs{action})) {
		if($attrs{action} eq 'create' ) {
			if (defined($attrs{cdevs}) and defined($attrs{level})) {
				if(defined($attrs{zerocmpsbs}) and $attrs{zerocmpsbs}) {
					@cdevs=split(/\s+/,$attrs{cdevs});
					foreach my $i (@cdevs) {
						runcmdvty('mdadm','--zero-superblock',$i);
					}
				}
				runcmdvty('mdadm','--'.$attrs{action},$attrs{dev},'--level',$attrs{level},
						'--raid-devices',1+$#cdevs,$attrs{cdevs});
			} else {
				mywarn(__LINE__,'myproc_machine_raid','Missing cdevs or level attribute!');
			}
		} elsif($attrs{action} eq 'stop') {
			runcmdvty('mdadm','--'.$attrs{action},$attrs{dev});
		} elsif($attrs{action} eq 'assemble') {
			if (defined($attrs{cdevs})) {
				runcmdvty('mdadm','--'.$attrs{action},$attrs{dev},$attrs{cdevs});
			} else {
				mywarn(__LINE__,'myproc_machine_raid','Missing cdevs attribute!');
			}
		} else {
			mywarn(__LINE__,'myproc_machine_raid','Unsupported raid action!');
		}
	} else {
		mywarn(__LINE__,'myproc_machine_raid','Missing dev or action attribute!');
		return;
	}
	nochild("Raid",$arg);
}

sub myproc_machine_pv ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my @opts=();
	if (defined($attrs{dev})) {
		if(defined($attrs{yes}) and $attrs{yes}) {
			push @opts,'-y';
		}
		if(defined($attrs{zero})) {
			push @opts,'-Z',$attrs{zero};
		}
		if(defined($attrs{force})) {
			for(my $i=0;$i<$attrs{force};$i++) { push @opts,'--force' }
		}
		runcmdvty('pvcreate',@opts,$attrs{dev});
	} else {
		mywarn(__LINE__,'myproc_machine_pv','Missing dev attribute!');
		return 0;
	}
	nochild("Phisical Volume",$arg);
}

sub myproc_machine_vg ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $node;
	if (defined($attrs{name}) and defined($attrs{pvols})) {
		runcmdvty('vgcreate',$attrs{name},$attrs{pvols});
	} else {
		print "Volume Group must have name and pvols attrs!\n" unless (defined($params{quiet}) and $params{quiet});
		return 0;
	}
	nochild("Volume Group",$arg);
}

sub myproc_machine_lv ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my @opts=();
	if (defined($attrs{name}) and defined($attrs{vg}) and defined($attrs{type}) and defined($attrs{size})) {
		runcmdvty('lvcreate','-n',$attrs{name},'-L',$attrs{size},$attrs{vg});
		if(defined($attrs{label})){push @opts,'-L',$attrs{label};}
		if(defined($attrs{mkfsopts})){push @opts,$attrs{mkfsopts};}
		if(grep { $attrs{type} eq $_ } keys(%fstypes) ) {
			runcmdvty(@{$fstypes{$attrs{type}}},@opts,'/dev/'.$attrs{vg}.'/'.$attrs{name})
				unless(defined($attrs{nomkfs}) and $attrs{nomkfs});
			if($attrs{type} eq 'swap') {
				push @fstab, ['/dev/mapper/'.$attrs{vg}.'-'.$attrs{name},'none','swap','sw','0','0'];
			} else {
				push @fstab, ['/dev/mapper/'.$attrs{vg}.'-'.$attrs{name},$attrs{target},$attrs{type},
					(defined($attrs{fstabopts})?$attrs{fstabopts}:'defaults'),
					(defined($attrs{dump})?$attrs{dump}:'0'),
					(defined($attrs{pass})?$attrs{pass}:($attrs{target} eq '/'?'0':'2'))]
					unless (!defined($attrs{target}));
			}
			# FIXME: szopacs van, ha a vg vagy lv nevében - jel van
		} elsif ($attrs{type} eq 'bare') {
		} else {
			print "Unsupported LV type:".$attrs{type}."\n" unless (defined($params{quiet}) and $params{quiet});
		}
	} else {
		print "Logical Volume must have vg,name,size and type attrs!\n"
			unless (defined($params{quiet}) and $params{quiet});
		return 0;
	}
	nochild("Logical Volume",$arg);
}

sub myproc_machine_fs ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my @opts;
	if(defined($params{chroot})) {	
		print "Do not add further fstab entries after install!\n" unless (defined($params{quiet}) and $params{quiet});
		return 0;
	}
	if (defined($attrs{dev}) and defined($attrs{target}) and defined($attrs{type})) {
		if(defined($attrs{label})){push @opts,'-L',$attrs{label};}
		if(defined($attrs{mkfsopts})){push @opts,$attrs{mkfsopts};}
		if(grep { $attrs{type} eq $_ } keys(%fstypes) ) {
			runcmdvty(@{$fstypes{$attrs{type}}},@opts,$attrs{dev})
				unless(defined($attrs{nomkfs}) and $attrs{nomkfs});
			if($attrs{type} eq 'swap') {
				push @fstab, [$attrs{dev},'none','swap','sw','0','0'];
			} else {
				push @fstab, [$attrs{dev},$attrs{target},$attrs{type},
					(defined($attrs{fstabopts})?$attrs{fstabopts}:'defaults'),
					(defined($attrs{dump})?$attrs{dump}:'0'),
					(defined($attrs{pass})?$attrs{pass}:'0')]
					unless (!defined($attrs{target}));
			}
		} else {
			print "Unsupported Filesystem type:".$attrs{type}."\n"
				unless (defined($params{quiet}) and $params{quiet});
		}
	} else {
		print "Filesystem must have dev,target and type attrs!\n" unless (defined($params{quiet}) and $params{quiet});
		return 0;
	}
	nochild("Filesystem",$arg);
}

# FIXME: hasznos lehetne egy olyan szolgáltatás, hogy a @fstab entry-ket sorbarendezze egymástól való függőség szerint.
sub myproc_machine_debootstrap ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my @opts=('debootstrap');
	if(defined($params{chroot})) {	
		print "Debootstrap can be called once!\n" unless (defined($params{quiet}) and $params{quiet});
		return 0;
	}
	if (defined($attrs{dist}) and defined($attrs{target})) {
		foreach my $i ('arch','include','exclude') {
			if(defined($attrs{$i})) {
				push @opts,'--'.$i,'"'.$attrs{$i}.'"';
			}
		}
		foreach my $i (@fstab) {
			if(${$i}[2] eq 'swap') {
				runcmdvty('swapon',${$i}[0]) unless (defined($attrs{noswap}) and $attrs{noswap});
				next;
			} else {
				trymkdir($attrs{target}."/".${$i}[1]);
				runcmdvty('mount','-t',${$i}[2],${$i}[0],$attrs{target}."/".${$i}[1],'-o',${$i}[3]);
			}
		}
		push @opts,$attrs{dist},$attrs{target};
		if(defined($attrs{url})) { push @opts,$attrs{url}; }
		runcmdvty(@opts);
		chdir $attrs{target};
		open F,">etc/hostname";
		print F $params{hostname}."\n";
		close F;
		open F,">etc/fstab";
		print F "# Initial fstab after serverinstaller\n".join("\t",'proc','/proc','proc','defaults','0','0')."\n";
		foreach my $i (@fstab) {
			if(${$i}[2] eq 'swap') {
				print F ${$i}[0]."\tnone\tswap\tsw\t0\t0\n";
			} else {
				print F join("\t",@{$i})."\n";
			}
		}
		close F;
		$params{chroot}=$attrs{target};
		runcmdvty("apt-get","update");
	} else {
		print "Debootstrap must have dist and target attrs!\n" unless (defined($params{quiet}) and $params{quiet});
		return 0;
	}
	nochild("Debootstrap",$arg);
}

sub myproc_machine_debconf ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $node;
	while (defined($node=shift @{$arg})) {
		if (not $node) {
			runcmdinput(mytrim(shift @{$arg}),"debconf-set-selections");
		} else {
			mywarn(__LINE__,'myproc_machine_debconf',"Shouldn't contain child node!");
			shift @{$arg};
		}
	}
}

sub myproc_machine_kernel ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $node;
	my $chroot=$params{chroot};
	if (!defined($params{chroot})) {
		mywarn(__LINE__,'myproc_machine_kernel',"You can't install a kernel without installing a system!");
		return;
	}
	if (defined($attrs{ver})) {
		open F,">etc/kernel-img.conf";
		print F "do_symlinks = ".(defined($attrs{do_symlinks})?$attrs{do_symlinks}:'no')."\n";
		print F "do_initrd = ".(defined($attrs{do_initrd})?$attrs{do_initrd}:'yes')."\n";
		close F;
		runcmdvty('apt-get','-y','install',
			(defined($attrs{pkgprefix})?$attrs{pkgprefix}:'linux-image').'-'.$attrs{ver});
		undef $params{chroot};
		if(defined($attrs{pushto})) {
			opendir D,'boot';
			my @files=grep { /^(vmlinuz-|initrd.img-)/ && -f 'boot/'.$_ } readdir (D);
			closedir D;
			foreach my $i (@files) {
				runcmdvty('tftp','-m','binary',$attrs{pushto},'-c','put','boot/'.$i,$params{hostname}.'.'.$i);
			}
		}
		$params{chroot}=$chroot;
	} else {
	}
}

sub myproc_machine_aptkey ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $node;
	if (!defined($params{chroot})) {
		mywarn(__LINE__,'myproc_machine_aptkey',"You can't install apt keys without installing a system!");
		return;
	}
	while (defined($node=shift @{$arg})) {
		if (not $node) {
			runcmdinput(mytrim(shift @{$arg}),"/usr/bin/apt-key","add","-");
		} else {
			mywarn(__LINE__,'myproc_machine_aptkey',"Shouldn't contain child node!");
			shift @{$arg};
		}
	}
}

sub myproc_machine_aptsource ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	if (!defined($params{chroot})) {
		mywarn(__LINE__,'myproc_machine_aptsource',"You can't install a apt sources without installing a system!");
		return;
	}
	if (defined($attrs{url}) and defined($attrs{dist}) and defined($attrs{parts})) {
		open F,">>etc/apt/sources.list";
		print F join(' ',$attrs{url},$attrs{dist},$attrs{parts})."\n";
		close F;
		runcmdvty('apt-get','update');
	} else {
		mywarn(__LINE__,'myproc_machine_aptsource',"Missing url,dist or parts attribute!");
		return;
	}
	nochild("AptSource",$arg);
}

sub myproc_machine_aptinst ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my @opts=();
	if (!defined($params{chroot})) {
		mywarn(__LINE__,'myproc_machine_aptinst',"You can't install a packages without installing a system!");
		return;
	}
	if (defined($attrs{packages})) {
		push @opts,'apt-get','install';
		foreach my $i ('yes','force-yes','download-only',
				'fix-broken','ignore-missing','quiet',
				'simulate','purge','reinstall',
				'trivial-only','autoremove',
				'allow-unauthenticated') {
			if(defined($attrs{$i})) {
				push @opts,'--'.$i;
			}
		}
		push @opts,$attrs{packages};
		runcmdvty(@opts);
	} else {
		mywarn(__LINE__,'myproc_machine_aptinst',"Missing packages attribute!");
		return;
	}
	nochild("AptInst",$arg);
}

sub myproc_machine_user ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $pwdfile='';
	my $pwdline;
	my %user;
	my @opts=();
	my $node;
	if (defined($attrs{name})) {
		open F,"etc/passwd";
		while(<F>) {
			$pwdline=$_;
			chop ;
			my %l;
			($l{user},$l{pwd},$l{uid},$l{gid},$l{gecos},$l{home},$l{shell})=split(/:/);
			if($attrs{name} eq $l{user}) {
				%user=%l;
				foreach my $i ('uid','gid','gecos','home','shell') {
					if (defined($attrs{$i})) {
						$l{$i}=$attrs{$i};
					}
				}
				$pwdfile.=join(':',$l{user},$l{pwd},$l{uid},$l{gid},$l{gecos},$l{home},$l{shell})."\n";
			} else {
				$pwdfile.=$pwdline;
			}
		}
		close F;
		if (defined($user{user})) {
			rename "etc/passwd","etc/passwd.save";
			open F,">etc/passwd";
			print F $pwdfile;
			close F;
		} else {
			push @opts,'adduser';
			if(defined($attrs{home})) { push @opts,'--home',$attrs{home};}
			if(defined($attrs{shell})) { push @opts,'--shell',$attrs{shell};}
			if(defined($attrs{gecos})) { push @opts,'--gecos','"'.$attrs{gecos}.'"';}
			if(defined($attrs{uid})) { push @opts,'--uid',$attrs{uid};}
			if(defined($attrs{gid})) { push @opts,'--gid',$attrs{gid};}
			if(defined($attrs{system}) and $attrs{system}) { push @opts,'--system';}
			push @opts,'--disabled-password',$attrs{name};
			runcmdvty(@opts);
			open F,"etc/passwd";
			while(<F>) {
				chop ;
				my %l;
				($l{user},$l{pwd},$l{uid},$l{gid},$l{gecos},$l{home},$l{shell})=split(/:/);
				if($attrs{name} eq $l{user}) {
					%user=%l;
				}
			}
			close F;
		}
		if (defined($attrs{pwd}) and -f 'etc/shadow') {
			$pwdfile='';
			open F,"etc/shadow";
			while(<F>) {
				my $pwdline=$_;
				chop;
				my ($name,$pw,$rem)=split(/:/,$_,3);
				if ($name eq $attrs{name}) {
					$pw=$attrs{pwd};
					$pwdfile.=join(':',$name,$pw,$rem)."\n";
				} else {
					$pwdfile.=$pwdline;
				}
			}
			close F;
			rename "etc/shadow","etc/shadow.save";
			open F,">etc/shadow";
			print F $pwdfile;
			close F;
		}
		foreach my $i (keys(%user)) {
			if (!defined($attrs{$i})) { $attrs{$i}=$user{$i}; }
		}
		while (defined($node= shift @{$arg})) {
			if (not $node) {
				print mytrim(shift @{$arg});
			} elsif ($node eq 'textfile') {
				myproc_machine_textfile(shift @{$arg},\%attrs);
			} elsif ($node eq 'dir') {
				myproc_machine_dir(shift @{$arg},\%attrs);
			} else {
				print $node.":".mytrim(shift @{$arg})."\n";
			}
		}
	} else {
		mywarn(__LINE__,'myproc_machine_user','Missing name attribute!');
		return 0;
	}
}

sub myproc_machine_group ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $pwdfile='';
	my $pwdline;
	my %user;
	my @opts=('addgroup');
	if (defined($attrs{name})) {
		if (defined($attrs{system}) and $attrs{system}) { push @opts,'--system'; }
		push @opts,$attrs{name};
		runcmdvty(@opts);
		if (defined($attrs{members})) {
			foreach my $i (split(/,/,$attrs{members})) {
				runcmdvty('adduser',$i,$attrs{name});
			}
		}
	} else {
		mywarn(__LINE__,'myproc_machine_group','Missing name attribute!');
		return 0;
	}
	nochild("Group",$arg);
}

sub myproc_machine_patch ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $node;
	my $chroot=$params{chroot};
	my @opts=();
	if (!defined($params{chroot})) {
		mywarn(__LINE__,'myproc_machine_patch',"You can't patch files without installing a system!");
		return;
	}
	push @opts,'patch';
	if(defined($attrs{p})) {
		push @opts,'-p'.$attrs{p};
	}
	foreach my $i ('s','e','f','t') {
		if(defined($attrs{$i}) and $attrs{$i}) {
			push @opts,'-'.$i;
		}
	}
	if(!defined($attrs{s}) and defined($params{quiet}) and $params{quiet}) {
		push @opts,'-s';
	}
	while (defined($node=shift @{$arg})) {
		if (not $node) {
			undef $params{chroot};
			runcmdinput(mytrim(shift @{$arg}),@opts);
			$params{chroot}=$chroot;
		} else {
			mywarn(__LINE__,'myproc_machine_patch',"Shouldn't contain child node!");
			shift @{$arg};
		}
	}
}

sub myproc_machine_textfile ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $node;
	my $name;
	my $uid;
	my $gid;
	if (!defined($params{chroot})) {
		mywarn(__LINE__,'myproc_machine_textfile',"You can't install files without installing a system!");
		return;
	}
	if (!defined($attrs{name})) {
		mywarn(__LINE__,'myproc_machine_textfile',"Missing name attr!");
		return;
	}
	$name=$attrs{name};
	if (defined($pattrs->{uid}))	{ $uid=$pattrs->{uid}; }
	if (defined($attrs{uid}   ))	{ $uid=$attrs{uid}; }
	if (defined($pattrs->{gid}))	{ $uid=$pattrs->{gid}; }
	if (defined($attrs{gid}   ))	{ $uid=$attrs{gid}; }
	while (defined($node=shift @{$arg})) {
		if (not $node) {
			my $fname=$params{chroot}.(defined($pattrs->{home})?$pattrs->{home}.'/':'').$name;
			my $mode=">";
			my $cnt;
			$mode.=">" if(defined($attrs{append}) and $attrs{append});
			open F,$mode.$fname;
			mydebug(__LINE__,'myproc_machine_textfile',$fname);
			$cnt=mytrim(shift@{$arg});
			map { $cnt=~s/__${_}__/$params{$_}/g} keys(%params);
			print F $cnt;
			close F;
			if (defined($uid) or defined($gid)) {
				if (!defined($uid)) {$uid=-1;}
				if (!defined($gid)) {$gid=-1;}
				chown $uid,$gid,$fname;
			}
			if (defined($attrs{mod})) {
				chmod oct($attrs{mod}),$fname;
			}
		} else {
			mywarn(__LINE__,'myproc_machine_textfile',"Shouldn't contain child node!");
			shift @{$arg};
		}
	}
}

sub myproc_machine_script ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $node;
	my $name;
	my $uid;
	my $gid;
	if (!defined($params{chroot})) {
		mywarn(__LINE__,'myproc_machine_script',"You can't run scripts before installing a system!");
		return;
	}
	if (defined($pattrs->{uid}))	{ $uid=$pattrs->{uid}; }
	if (defined($attrs{uid}   ))	{ $uid=$attrs{uid}; }
	if (defined($pattrs->{gid}))	{ $uid=$pattrs->{gid}; }
	if (defined($attrs{gid}   ))	{ $uid=$attrs{gid}; }
	if (!defined($attrs{mod}  ))	{ $attrs{mod}="700"; }
	while (defined($node=shift @{$arg})) {
		if (not $node) {
			my $basedir=$params{chroot}.(defined($pattrs->{home})?$pattrs->{home}.'/':'');
			my ($fh,$fname)=tempfile(DIR=>$basedir);
			$fname=~s|^$params{chroot}||;
			mydebug(__LINE__,'myproc_machine_script',$fname);
			print $fh "#!/bin/bash\n";
			print $fh mytrim(shift@{$arg});
			close $fh;
			if (defined($uid) or defined($gid)) {
				if (!defined($uid)) {$uid=-1;}
				if (!defined($gid)) {$gid=-1;}
				chown $uid,$gid,$fname;
			}
			mydebug(__LINE__,'myproc_machine_script',$basedir.'/'.$fname.':'.oct($attrs{mod}));
			chmod oct($attrs{mod}),$basedir.'/'.$fname;
			runcmdvty((defined($pattrs->{home})?$pattrs->{home}.'/':'').$fname);
			unlink $basedir.'/'.$fname;
		} else {
			mywarn(__LINE__,'myproc_machine_script',"Shouldn't contain child node!");
			shift @{$arg};
		}
	}
}

sub myproc_machine_dir ($$) {
	my $arg=shift;		# XML node
	my $pattrs=shift;	# Parent attribs
	my %attrs=%{shift @{$arg}};
	my $node;
	my $name;
	my $uid;
	my $gid;
	if (!defined($params{chroot})) {
		mywarn(__LINE__,'myproc_machine_dir',"You can't install dirs without installing a system!");
		return;
	}
	if (!defined($attrs{name})) {
		mywarn(__LINE__,'myproc_machine_dir',"Missing name attr!");
		return;
	}
	$name=$attrs{name};
	if (defined($pattrs->{uid}))	{ $uid=$pattrs->{uid}; }
	if (defined($attrs{uid}   ))	{ $uid=$attrs{uid}; }
	if (defined($pattrs->{gid}))	{ $uid=$pattrs->{gid}; }
	if (defined($attrs{gid}   ))	{ $uid=$attrs{gid}; }
	my $dname=$params{chroot}.(defined($pattrs->{home})?$pattrs->{home}.'/':'').$name;
	trymkdir($dname);
	mydebug(__LINE__,'myproc_machine_dir',$dname);
	if (defined($uid) or defined($gid)) {
		if (!defined($uid)) {$uid=-1;}
		if (!defined($gid)) {$gid=-1;}
		chown $uid,$gid,$dname;
	}
	if (defined($attrs{mod})) {
		chmod oct($attrs{mod}),$dname;
	}
	while (defined($node=shift @{$arg})) {
		if (not $node) {
			print mytrim(shift@{$arg});
		} else {
			mywarn(__LINE__,'myproc_machine_dir',"Shouldn't contain child node!");
			shift @{$arg};
		}
	}
}

$hostname=$ARGV[1];
$x=XML::Parser->new(Style=>'Tree');
open F, $ARGV[0];
$y=$x->parse(*F);
close F;
if (defined($params{debug}) and $params{debug}) { print Data::Dumper->Dump($y) ; }
#print Data::Dumper->Dump($y) ;
myproc ($y);

# vim:filetype=perl