home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / perl5 / Immunix / Config.pm next >
Encoding:
Perl POD Document  |  2008-10-08  |  2.8 KB  |  118 lines
  1. # ----------------------------------------------------------------------
  2. #    Copyright (c) 2006 Novell, Inc. All Rights Reserved.
  3. #
  4. #    This program is free software; you can redistribute it and/or
  5. #    modify it under the terms of version 2 of the GNU General Public
  6. #    License as published by the Free Software Foundation.
  7. #
  8. #    This program is distributed in the hope that it will be useful,
  9. #    but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11. #    GNU General Public License for more details.
  12. #
  13. #    You should have received a copy of the GNU General Public License
  14. #    along with this program; if not, contact Novell, Inc.
  15. #
  16. #    To contact Novell about this file by physical or electronic mail,
  17. #    you may find current contact information at www.novell.com.
  18. # ----------------------------------------------------------------------
  19.  
  20. package Immunix::Config;
  21.  
  22. use strict;
  23. use warnings;
  24.  
  25. use Carp;
  26. use Cwd qw(cwd realpath);
  27. use File::Basename;
  28. use File::Temp qw/ tempfile tempdir /;
  29. use Data::Dumper;
  30. use Locale::gettext;
  31. use POSIX;
  32.  
  33. require Exporter;
  34. our @ISA    = qw(Exporter);
  35. our @EXPORT = qw(
  36.     read_config
  37.     write_config
  38.     find_first_file
  39.     find_first_dir
  40. );
  41.  
  42. our $confdir = "/etc/apparmor";
  43.  
  44. # config vars
  45. our $cfg;
  46. our $repo_cfg;
  47.  
  48. sub read_config {
  49.     my $filename = shift;
  50.     my $config;
  51.  
  52.     if (open(CONF, "$confdir/$filename")) {
  53.         my $which;
  54.         while (<CONF>) {
  55.             chomp;
  56.             # ignore comments
  57.             next if /^\s*#/;
  58.             if (m/^\[(\S+)\]/) {
  59.                 $which = $1;
  60.             } elsif (m/^\s*(\S+)\s*=\s*(.*)\s*$/) {
  61.                 my ($key, $value) = ($1, $2);
  62.                 $config->{$which}{$key} = $value;
  63.             }
  64.         }
  65.         close(CONF);
  66.     }
  67.  
  68.     return $config;
  69. }
  70.  
  71. sub write_config {
  72.     my ($filename, $config) = @_;
  73.     if (open(my $CONF, ">$confdir/$filename")) {
  74.         for my $section (sort keys %$config) {
  75.             print $CONF "[$section]\n";
  76.  
  77.             for my $key (sort keys %{$config->{$section}}) {
  78.                 print $CONF "  $key = $config->{$section}{$key}\n"
  79.                     if ($config->{$section}{$key});
  80.             }
  81.         }
  82.         chmod(0600, $CONF);
  83.         close($CONF);
  84.     } else {
  85.         die "Can't write config file $filename: $!";
  86.     }
  87. }
  88.  
  89. sub find_first_file {
  90.     my $list = shift;
  91.     return if ( not defined $list );
  92.     my $filename;
  93.     for my $f (split(/\s+/, $list)) {
  94.         if (-f $f) {
  95.             $filename = $f;
  96.             last;
  97.         }
  98.     }
  99.  
  100.     return $filename;
  101. }
  102.  
  103. sub find_first_dir {
  104.     my $list = shift;
  105.     return if ( not defined $list );
  106.     my $dirname;
  107.     for my $f (split(/\s+/, $list)) {
  108.         if (-d $f) {
  109.             $dirname = $f;
  110.             last;
  111.         }
  112.     }
  113.  
  114.     return $dirname;
  115. }
  116.  
  117. 1;
  118.