diff -up smeserver-thinclient-2.1/root/etc/e-smith/web/functions/thinclient.archive smeserver-thinclient-2.1/root/etc/e-smith/web/functions/thinclient --- smeserver-thinclient-2.1/root/etc/e-smith/web/functions/thinclient.archive 2016-04-03 21:25:05.000000000 +1000 +++ smeserver-thinclient-2.1/root/etc/e-smith/web/functions/thinclient 2016-04-25 20:18:35.000000000 +1000 @@ -27,6 +27,8 @@ use esmith::cgi; use esmith::ConfigDB; use esmith::util; use FileHandle; +use File::Basename; +use File::Path qw(make_path remove_tree); sub showInitial ($$$$); sub showStatusReport ($$$$); @@ -40,7 +42,8 @@ sub saveDistribution ($); sub saveConfiguration ($); sub showDistributionPanel ($$$); sub showWorkstationPanel ($$$); - +sub checkarchive ($); +sub readini($); BEGIN { @@ -61,8 +64,8 @@ my $pxeclients = esmith::ConfigDB->open( my $hosts = esmith::ConfigDB->open_ro('hosts'); -my $version = '2.1-2'; +my $version = '2.1-3'; my $email = 'trevorbatley@users.sourceforge.net'; my $title = 'Thin Client Configuration'; my $copyright = 'copyright (c) 2004, Trevor Batley, '.$email.''; my $sendreports = 'Please raise Bugs and Feature Requests in Bugzilla (SMEContribs => smeserver-thinclient)'; @@ -384,12 +387,12 @@ sub showPXEGlobals($) sub showPXEDists($) { my ($q) = @_; - my $tftproot = "/tftproot/"; + my $tftproot = "/tftpboot/"; if ($config->get('tftpd')) { if ($config->get('tftpd')->prop('status') eq 'enabled') { - $tftproot = $config->get('tftpd')->prop('tftproot') + $tftproot = $config->get('tftpd')->prop('tftproot') || "/tftpboot/"; } } @@ -430,30 +433,30 @@ sub showPXEDists($) foreach my $dist (sort @distkeys) { my $distrec = $pxeclients->get($dist); - my $dtype = $distrec->prop('install') || "Manual"; - if ($dtype ne "Manual") + my $install = $distrec->prop('install') || "Manual"; + if ($install eq "Manual" || $install eq 'Archive') { print $q->Tr (esmith::cgi::genSmallCell ($q, $dist, 'normal'), - esmith::cgi::genSmallCell ($q, $tftproot . ($distrec->prop('dir') || ""), 'normal'), - esmith::cgi::genSmallCell ($q, "RPM", 'normal'), - esmith::cgi::genSmallCell ($q, + esmith::cgi::genSmallCell ($q, $tftproot.($distrec->prop('dir') || ""), 'normal'), + esmith::cgi::genSmallCell ($q, $install, 'normal'), + esmith::cgi::genCell ($q, $q->a ({href => $q->url (-absolute => 1) . "?state=showDist&acct=Delete&dist=" - . $dist}, 'Remove...'), 'normal')); + . $dist}, 'Remove...'), 'normal'), + esmith::cgi::genCell ($q, + $q->a ({href => $q->url (-absolute => 1) + . "?state=showDist&acct=Change&dist=" + . $dist}, 'Modify...'), 'normal')); } else { print $q->Tr (esmith::cgi::genSmallCell ($q, $dist, 'normal'), esmith::cgi::genSmallCell ($q, $tftproot . ($distrec->prop('dir') || ""), 'normal'), - esmith::cgi::genSmallCell ($q, $dtype, 'normal'), - esmith::cgi::genSmallCell ($q, + esmith::cgi::genSmallCell ($q, $install, 'normal'), + esmith::cgi::genCell ($q, $q->a ({href => $q->url (-absolute => 1) . "?state=showDist&acct=Delete&dist=" - . $dist}, 'Remove...'), 'normal'), - esmith::cgi::genSmallCell ($q, - $q->a ({href => $q->url (-absolute => 1) - . "?state=showDist&acct=Change&dist=" - . $dist}, 'Modify...'), 'normal')); + . $dist}, 'Remove...'), 'normal')); } } print $q->end_table; @@ -541,15 +544,18 @@ sub showDistributionPanel($$$) my $action = $q->param ('acct'); my $dist = $q->param ('dist') || ""; - my $dir = ""; - my $prog = "pxelinux.0"; - my $tftproot = "/tftproot/"; + my $dir = $q->param ('dir') || ""; + my $prog = $q->param ('prog') || "pxelinux.0"; + my $ini = $q->param('ini') || ""; + my $origdir = $q->param('origdir') || ""; + my $install = $q->param('install') || "Manual"; + my $tftproot = "/tftpboot/"; if ($config->get('tftpd')) { - if ($config->get('tftpd')->prop('status') eq 'enabled') - { - $tftproot = $config->get('tftpd')->prop('tftproot') - } + if ($config->get('tftpd')->prop('status') eq 'enabled') + { + $tftproot = $config->get('tftpd')->prop('tftproot') || "/tftpboot/"; + } } esmith::cgi::genHeaderNonCacheable ($q, $config, $action . " Distribution"); @@ -558,18 +564,18 @@ sub showDistributionPanel($$$) if ($err ne '') {showStatusReport ($q, 'error', $err, $log)}; - print $q->start_table ({-class => "sme-noborders"}); - # --- Distribution Name if ($action eq 'Add') { - print $q->p ('You can add a Distribution via a prebuilt rpm.

', - 'Select the rpm file to load from your local workstation. No checking is done on this file!', + print $q->p ('You can add a Distribution via a prebuilt archive.

', + 'Select the file to load from your local workstation. Minimal checking is done on this file!', ); + print $q->p ; + print $q->start_table ({-class => "sme-noborders"}); print $q->Tr ( - $q->td ({-class => "sme-noborders-label"}, "Distribution .rpm:"), + $q->td ({-class => "sme-noborders-label"}, "Archive:"), $q->td ({-class => "sme-noborders-content"}, - $q->filefield(-name => 'rpmfile', + $q->filefield(-name => 'archive', -default => "smeserver-thinclient--.noarch.rpm", -size => 32))); @@ -581,67 +587,163 @@ sub showDistributionPanel($$$) ); $dist = ""; + print $q->p ; print $q->Tr ( - esmith::cgi::genNameValueRow ($q, "Name", "dist", $dist), - ); + $q->td ({-class => "sme-noborders-label"}, "Distribution:"), + $q->td ({-class => "sme-noborders-content"}, $q->textfield (-name => "dist", -override => 1, -default => $dist, -size => 32))); + print $q->Tr ( + $q->td ({-class => "sme-noborders-label"}, "Directory:".$tftproot), + $q->td ({-class => "sme-noborders-content"}, $q->textfield (-name => "dir", -override => 1, -default => $dir, -size => 32))); + print $q->Tr ( + $q->td ({-class => "sme-noborders-label"}, "Executable:"), + $q->td ({-class => "sme-noborders-content"}, $q->textfield (-name => "prog", -override => 1, -default => $prog, -size => 32))); + print $q->end_table; } - else + elsif ($action eq 'Confirm') + # Confirm ONLY applies to Distributions from an archive or if they have entered the name of an existing Distribution { - my $install = $pxeclients->get_prop($dist, 'install') || "Manual"; - if ($install eq "Manual") + if ($pxeclients->get($dist)) { - print $q->p ('This ONLY alters the parameters within dhcp, so any changes required to directories or ', - 'files associated with your Distribution must be manually performed by you.'); + print $q->p (''.$dist.' already exists. Do you really want to do this? Or do you want to define a new name and directory below?'); } - # --- Warning messages else { - if ($action eq 'Delete') - { - print $q->p ('This Distribution was installed as an rpm, it will be removed via rpm -e!'); - } - else - { - print $q->p ('This Distribution was installed as an rpm, we should not be able to do this!'); - } + if ( $dir && -e "$tftproot$dir" ) + { + print $q->p ($tftproot.$dir.' already exists. Do you really want to put this here? Or do you want to define a new directory below?'); + } + } + if ($ini) + { + print $q->p ('These values came from your uploaded archive, you can change them if you want.
', + 'We will move the content to the new directory, if you change it.' + ); + } + else + { + my $message = "Please enter the values you want for this distribution.
"; + if ($install eq "Manual") + { + $message .= "This will just store these parameters in the database."; + } + else + { + $message .= "Files from the archive will be installed into the directory you define."; + } + print $q->p ($message); + } + print $q->p ; + print $q->start_table ({-class => "sme-noborders"}); + print $q->Tr ($q->td ({-class => "sme-noborders-label"}, "Distribution:"), + $q->td ({-class => "sme-noborders-content"}, + $q->textfield (-name => "dist", -override => 1, -default => $dist, -size => 32))); + print $q->Tr ($q->td ({-class => "sme-noborders-label"}, "Directory:".$tftproot), + $q->td ({-class => "sme-noborders-content"}, + $q->textfield (-name => "dir", -override => 1, -default => $dir, -size => 32))); + print $q->Tr ( + $q->td ({-class => "sme-noborders-label"}, "Executable:"), + $q->td ({-class => "sme-noborders-content"}, $q->textfield (-name => "prog", -override => 1, -default => $prog, -size => 32))); + print $q->end_table; + print $q->p ('Press Confirm to install this distribution in the directory defined.'); + print $q->p ; + print $q->hidden (-name=>'install', -value=>'archive'); + } + elsif ($action eq 'Delete') + { + my $record = $pxeclients->get($dist); + $dir = $record->prop('dir') || ""; + $prog = $record->prop('prog') || "pxelinux.0"; + my $install = $record->prop('install') || "Manual"; + print $q->p ('This will delete the '.$dist.' Distribution from the database'); + if ($install eq 'Manual' || $install eq 'Archive') + { + if ($dir) +# Don't try to delete the tftp root directory :) + { + print $q->p ('If you want to remove the '.$tftproot.$dir.' directory, and all files, please tick "Delete the '.$tftproot.$dir.' directory and all contents?"'); + } + else + { + print $q->p ("You can't delete the $tftproot$dir directory, so you'll have to manipulate the files yourself"); + } + } + else + { + print $q->p ('This Distribution was installed as an rpm, it will be removed via rpm -e!
', + 'Which will remove all associated files and database entries.', + ); } + print $q->p ; + print $q->start_table ({-class => "sme-noborders"}); print $q->Tr( $q->td ({-class => "sme-noborders-label"}, "Name: "), $q->td({-class => "sme-noborders-content"}, $dist), ); - - my $record = $pxeclients->get($dist); - $dir = $record->prop('dir') || ""; - $prog = $record->prop('prog') || "pxelinux.0"; + print $q->Tr( + $q->td ({-class => "sme-noborders-label"}, "Directory: "), + $q->td ({-class => "sme-noborders-content"}, $tftproot.$dir), + ); + print $q->Tr( + $q->td ({-class => "sme-noborders-label"}, "Executable: "), + $q->td ({-class => "sme-noborders-content"}, $prog), + ); + print $q->end_table; + if ($install eq 'Manual' || $install eq 'Archive') + { + if ($dir) +# Don't try to delete the tftp root directory :) + { + print $q->p ("Delete the $tftproot$dir directory and all contents?"); + print $q->p ; + } + print $q->hidden (-name=>'dir', -value=>$dir); + } print $q->hidden (-name=>'dist', -value=>$dist); print $q->hidden (-name=>'install', -value=>$install); } - - # --- Default Distribution - if ($action eq 'Delete') + elsif ($action eq 'Change') { + my $record = $pxeclients->get($dist); + $dir = $record->prop('dir') || ""; + $prog = $record->prop('prog') || "pxelinux.0"; + print $q->p ('You can alter the '.$dist.' Distribution parameters in the database'); + if ($dir) +# Don't try to move the tftp root directory :) + { + print $q->p ('If you want to move the '.$tftproot.$dir.' directory, and all files,
', + '- please enter the new directory name in the Directory box, and
', + '- tick "Move '.$tftproot.$dir.' and contents?"' + ); + } + else + { + print $q->p ("You can't move the $tftproot$dir directory, so you'll have to manipulate the files yourself"); + } + print $q->p ; + print $q->start_table ({-class => "sme-noborders"}); + print $q->Tr ( + esmith::cgi::genNameValueRow ($q, "Name", "dist", $dist), + ); print $q->Tr( - $q->td ({-class => "sme-noborders-label"}, "Directory: " . $tftproot), - $q->td ({-class => "sme-noborders-content"}, $dir), - ); + $q->td ({-class => "sme-noborders-label"}, "Directory: "), + $q->td ({-class => "sme-borders-content"}, "$tftproot"), + ); print $q->Tr( - $q->td ({-class => "sme-noborders-label"}, "Executable: "), - $q->td ({-class => "sme-noborders-content"}, $prog), - ); - print $q->hidden (-name=>'dir', -value=>$dir); - print $q->hidden (-name=>'prog', -value=>$prog); + $q->td ({-class => "sme-noborders-label"}, "Executable: "), + $q->td ({-class => "sme-borders-content"}, ""), + ); + print $q->end_table; + if ($dir) +# Don't try to move the tftp root directory :) + { + print $q->p ({-class => "sme-noborders-content"}, "Move $tftproot$dir and contents?"); + print $q->p ; + } } else { - print $q->Tr ( - esmith::cgi::genNameValueRow ($q, "Directory \(/tftpboot/\)", 'dir', $dir), - ); - print $q->Tr ( - esmith::cgi::genNameValueRow ($q, "Executable", 'prog', $prog), - ); + showStatusReport ($q, 'error', "We should never get here (Action=$action)", $log) } - - print $q->end_table,"\n"; print $q->submit (-name=>'acct', -value=>$action); if ($action ne 'Delete') @@ -649,6 +751,7 @@ sub showDistributionPanel($$$) print $q->submit (-name=>'reset', -value=>'Reset'); print $q->hidden (-name=>'origacct', -value=>$action); print $q->hidden (-name=>'origdist', -value=>$dist); + print $q->hidden (-name=>'origdir', -value=>$dir); } print $q->defaults (-name=>'Cancel'); @@ -677,12 +780,12 @@ sub showWorkstationPanel($$$) my $base = ""; my $status = ""; my $distdir = ""; - my $tftproot = "/tftproot/"; + my $tftproot = "/tftpboot/"; if ($config->get('tftpd')) { if ($config->get('tftpd')->prop('status') eq 'enabled') { - $tftproot = $config->get('tftpd')->prop('tftproot') + $tftproot = $config->get('tftpd')->prop('tftproot') || "/tftpboot/"; } } @@ -1031,96 +1134,242 @@ sub saveClient ($) sub saveDistribution ($) { my ($q) = @_; + my $action = $q->param('acct'); + my $dist = $q->param('dist'); + my $dir = $q->param('dir'); + my $prog = $q->param('prog'); + my $archive = $q->param('archive'); + my $ext = $q->param('ext') || ""; + my $deldir = $q->param('deldir'); + my $movedir = $q->param('movedir'); + my $install = $q->param('install') || "Manual"; + my $origacct = $q->param('origacct'); + my $origdist = $q->param('origdist'); + my $origdir = $q->param('origdir'); + my $origprog = $q->param('origprog'); + my $safe_filename_characters = "a-zA-Z0-9_.-"; + my $tftproot = $config->get('tftpd')->prop('tftproot') || "/tftpboot/"; + my $ini = "";; if ($q->param('reset')) { - my $origacct = $q->param('origacct'); - my $origdist = $q->param('origdist'); $q = new CGI(""); $q->param(-name=>'acct', -value=>$origacct); $q->param(-name=>'dist', -value=>$origdist); + $q->param(-name=>'dir', -value=>$origdir); + $q->param(-name=>'prog', -value=>$origprog); showDistributionPanel ($q, '', ''); return; } - my $action = $q->param('acct'); - my $dist = $q->param('dist'); - my $dir = $q->param('dir'); - my $prog = $q->param('prog'); - - if ($action eq "Add") + if ($action eq 'Add') { - my $rpmfile = $q->param('rpmfile'); - if ("$rpmfile" ne "") + if ($archive) { - unlink ("/tmp/thinclient.rpm"); - open (WR,">/tmp/thinclient.rpm") || die ("Error while opening temporally file.\n"); - while (<$rpmfile>) - { - print WR; - } - close WR; - if (system ("/bin/rpm -Uvh /tmp/thinclient.rpm > /var/log/thinclient.log 2>&1")) - { - showDistributionPanel($q, "Error occurred during rpm install.", "/var/log/thinclient.log"); - return; - } - $dist = "via .rpm"; +# If we are adding via an archive: +# - upload the archive +# - extract the archive +# - check if it has a thinclient.ini file and load defaults if it does + $install = "Archive"; + # Untaint the filename + if ( $archive =~ /^([$safe_filename_characters]+)$/ ) + { + $archive = $1; + } + else + { + die "Filename contains invalid characters"; + } + # Upload the file + my $fharchive = $q->param('archive'); + remove_tree ("/tmp/$archive"); + open (WR,">/tmp/$archive") || die ("Error while opening temporally file.\n"); + binmode WR; + while ( <$fharchive> ) + { + print WR; + } + close WR; + # Extract the archive + my ( $name, $path, $ext ) = fileparse ( $archive, qr/\.[^.]*/ ); + my $unzip = "/bin/tar -xf /tmp/$archive -C /tmp/thinclient"; + if ($ext eq ".rpm") + { + $unzip = "/bin/rpm -Uvh /tmp/$archive"; + $install = $archive; + } + elsif ($ext eq ".zip") + { + $unzip = "/usr/bin/unzip /tmp/$archive -d /tmp/thinclient"; + } + else + { + $unzip = "/bin/tar -xf /tmp/$archive -C /tmp/thinclient"; + } + remove_tree ("/tmp/thinclient"); + mkdir "/tmp/thinclient"; + if (system ($unzip." > /var/log/thinclient.log 2>&1")) + { + showDistributionPanel($q, "Error occurred during archive extract.(ext=$ext)", "/var/log/thinclient.log"); + return; + } + # Now that we have unpacked it, delete the uploaded archive + unlink "/tmp/$archive"; + # If there is a thinclient.ini within the archive, use the parameters in it + if (-e "/tmp/thinclient/thinclient.ini") + { + my $cfg = readini( "/tmp/thinclient/thinclient.ini" ); + unlink "/tmp/thinclient/thinclient.ini"; + $dist = $cfg->{"params"}->{"dist"}; + $dir = $cfg->{"params"}->{"dir"}; + $prog = $cfg->{"params"}->{"prog"} || "pxelinux.0"; + $ini = "yes"; + } + if ($ext ne ".rpm") +# rpms do everything themselves (db params & install) +# We ask for confirmation of parameters for all other archive types + { + $q = new CGI(""); + $q->param(-name=>'acct', -value=>"Confirm"); + $q->param(-name=>'dist', -value=>$dist); + $q->param(-name=>'dir', -value=>$dir); + $q->param(-name=>'prog', -value=>$prog); + $q->param(-name=>'install', -value=>$install); + $q->param(-name=>'ini', -value=>$ini); + showDistributionPanel ($q, '', ''); + return; + } } else { - if ($dist eq "") - { - showDistributionPanel ($q, "You must either, enter a Name, or select an rpm to load. $action unsuccessfull", ''); +# It must be a Manual entry + if ($pxeclients->get($dist)) + { + $q = new CGI(""); + $q->param(-name=>'acct', -value=>"Confirm"); + $q->param(-name=>'dist', -value=>$dist); + $q->param(-name=>'dir', -value=>$dir); + $q->param(-name=>'prog', -value=>$prog); + $q->param(-name=>'install', -value=>"Manual"); + showDistributionPanel ($q, '', ''); + return; + } + my %newvalues = ('type' => 'dist', + 'dir' => $dir, + 'prog' => $prog, + 'install' => 'Manual'); + my $distrecord = $pxeclients->new_record($dist, \%newvalues); + } + } + elsif ($action eq 'Confirm') + { +# We ONLY get to Confirm, if it's an archive install (non rpm) +# Move the contents of the archive into the specified directory +# and update the config + if ( $dist eq "" ) + { + showDistributionPanel ($q, "You MUST define a Distribution name.", ''); return; - } - my %newvalues = ('type' => 'dist', - 'dir' => $dir, - 'prog' => $prog, - 'install' => 'Manual'); - my $distrecord = $pxeclients->new_record($dist, \%newvalues); + } + if ( $dir =~ /^([$safe_filename_characters]+)$/ ) + { + $dir = $1; + } + else + { + die "Directory contains invalid characters\n"; } + rename ("/tmp/thinclient", "$tftproot$dir"); + my %newvalues = ('type' => 'dist', + 'dir' => $dir, + 'prog' => $prog, + 'install' => 'Archive'); + my $distrecord = $pxeclients->new_record($dist, \%newvalues); } - else + elsif ($action eq "Delete") { - my $install = $q->param('install'); - - if ($action eq "Delete") + if ($install eq "Manual" || $install eq "Archive") { - if ($install eq "Manual") - { my $distrecord = $pxeclients->get($dist); $distrecord->delete; - } - else - { + # If they ticked the delete directory box, delete it + if ( $dir =~ /^([$safe_filename_characters]+)$/ ) + { + $dir = $1; + } + else + { + die "Filename contains invalid characters"; + } + if ($deldir eq 'yes') + { + remove_tree ("$tftproot$dir"); + } + } + else + # We have to assume it's via rpm + { my $rpm = $pxeclients->get_prop($dist, 'install'); if (system ("/bin/rpm -e $rpm > /var/log/thinclient.log 2>&1")) { showDistributionPanel($q, "Error occurred during rpm uninstall.", "/var/log/thinclient.log"); return; } - } } - elsif ($action eq "Change") + } + elsif ($action eq "Change") + { + if ($install eq "Manual" || $install eq "Archive") { - if ($install eq "Manual") - { - my $distrecord = $pxeclients->get($dist); - $distrecord->set_prop('dir' => $dir); - $distrecord->set_prop('prog' => $prog); - } - else - { - showDistributionPanel ($q, "This Distribution was installed via rpm. You can\'t modify these settings.", ''); - return; - } + if ($dist eq $origdist) + # If the Distribution name hasn't changed, just update the fields + { + my $distrecord = $pxeclients->get($origdist); + $distrecord->set_prop('dir' => $dir); + $distrecord->set_prop('prog' => $prog); + } + else + # If the Distribution name has changed, create the new one and delete the old + { + my %newvalues = ('type' => 'dist', + 'dir' => $dir, + 'prog' => $prog, + 'install' => 'Archive'); + my $distrecord = $pxeclients->new_record($dist, \%newvalues); + my $distrecord = $pxeclients->get($origdist); + $distrecord->delete; + } + if ($dir ne $origdir && $movedir eq 'yes') + { + if ( $origdir =~ /^([$safe_filename_characters]+)$/ ) + { + $origdir = $1; + } + else + { + die "Filename contains invalid characters"; + } + if ( $dir =~ /^([$safe_filename_characters]+)$/ ) + { + $dir = $1; + } + else + { + die "Filename contains invalid characters"; + } + rename ("$tftproot$origdir", "$tftproot$dir"); + } } else { + showDistributionPanel ($q, "This Distribution was installed via rpm. You can\'t modify these settings.", ''); + return; + } + } + else + { showDistributionPanel ($q, "$action, Oops!", ''); return; - } } if (system ("/sbin/e-smith/signal-event thinclient-conf > /var/log/thinclient.log 2>&1")) @@ -1129,9 +1378,9 @@ sub saveDistribution ($) return; } - showInitial ($q, "success", "$action of Distribution [$dist], successfull", ""); - + showInitial ($q, "success", "$action of Distribution $dist, successfull", ""); return; + } # ---------------------------------------------------------------------------- @@ -1197,3 +1446,64 @@ sub checkip($) return 'OK'; } +# ---------------------------------------------------------------------------- +# --- +# --- subroutine checkarchive +# --- check the archive type and determine appropriate command to extract +# --- +# ---------------------------------------------------------------------------- + +sub checkarchive($) + { + my ($archive) = @_; + + return undef unless defined $archive; + + my ($ext) = $archive =~ /((\.[^.\s]+)+)$/; + if ($ext eq "tar.gz" || $ext eq "tgz" || $ext eq "tar.bz2" || $ext eq "tbz2" ) + { + return "/bin/tar -xf /tmp/$archive -C /tmp/thinclient/", $ext; + + } + elsif ($ext eq "zip") + { + return "/usr/bin/unzip /tmp/$archive -d /tmp/thinclient/", $ext; + } + elsif ($ext eq "rpm") + { + return "/bin/rpm -Uvh /tmp/$archive", $ext; + } + else + { + # We'll try tar and hope it understands the extension..... + return "/bin/tar -xf /tmp/$archive -C /tmp/thinclient/", $ext; + } + } + +# ---------------------------------------------------------------------------- +# --- +# --- subroutine read an ini file +# --- +# ---------------------------------------------------------------------------- + +sub readini($) + { + my ($ini) = @_; + my $cfg; + my $section; + open (INI, "$ini") || die "Can't open $ini: $!\n"; + while () { + chomp; + if ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) + { + $section = $1; + } + if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) + { + $cfg->{$section}->{$1} = $2; + } + } + close (INI); + return $cfg; + } + \ No newline at end of file