umltools/ConfigPatcher/Handlers.pm

package ConfigPatcher::Handlers;

use strict;
use warnings;

use UML::Utils;

sub s2f {
  my $filename = shift;
  my $string = shift;
  open(FH, '>' . $filename);
  print FH $string;
  print FH "\n";
  close(FH);
}

sub f2s {
  my $filename = shift;
  # read file at once (be careful with big files!!!)
  open(FH, '<' . $filename);
  my @buf_arr = <FH>;
  my $buf = join("", @buf_arr);
  close(FH);
  return $buf;
}

sub a2f {
  my $filename = shift;
  my $string = shift;
  open(FH, '>>' . $filename);
  print FH "\n";
  print FH $string;
  print FH "\n";
  close(FH);
}

sub ris {
  my $string = shift;
  my $rules = shift;

  our $ris_result = 1;

  if (ref $rules eq 'HASH') {
    my @re_find = keys %{$rules};
    # replace all keys with substitutes from hash "%re_table"
    foreach my $find (@re_find) {
      my $replace = $rules->{$find};
      $ris_result &= ($string =~ s/$find/$replace/g);
    }
  }
  
  if (ref $rules eq 'ARRAY') {
    foreach my $rule (@{$rules}) {
      my $find    = $rule->[0];
      my $replace = $rule->[1];
      $ris_result &= ($string =~ s/$find/$replace/g);
    }
  }
  
  return $string;
}

sub rif {
  my $filename = shift;
  my $rules = shift;
  my $out_suffix = shift;

  my $outfile = $filename;
  $outfile .= '.' . $out_suffix if ($out_suffix);

  my $buf = f2s($filename);
  $buf = ris($buf, $rules);
  s2f($outfile, $buf);
}

sub findKeyEntries {
  my $string = shift;
  my $pattern = shift;
  my @arr = split("\n", $string);
  my @entries;
  foreach (@arr) {
    chomp;
    #print "l: ", $_, "\n";
    if (m/$pattern/) {
      push @entries, $1;
    }
  }
  return \@entries;
}

# ---------------------------------
# is a context-entry in a file?
# a "context-entry" is an entry identified 
# by a certain keystring, which itself 
# is detected dynamically
sub isEntryInFile {

  my $chk = shift;
  my $content_current = f2s($chk->{filename});
  
  # try to find all key-entries via patterns which are "entry-identifiers"
  if (my @keys = @{ findKeyEntries($chk->{'out'}, $chk->{'pattern'}{'EntryIdent'}) }) {
    # iterate through all "entry-identifiers"
    foreach (@keys) {
      my $pattern = $chk->{'pattern'}{'EntryCheck'};
      $pattern =~ s/\@\@KEY\@\@/$_/;
      my $bool_AlreadyThere = ($content_current =~ m/$pattern/);
      if ($bool_AlreadyThere) {
        $chk->{'EntryFound'} = $_;
        return 1;
      }
    }
  }

}


sub generic_hostname {
  my $filename = shift;
  my $hostname = $ConfigPatcher::Main::vhost{'net'}{'hostname'};
  s2f($filename, $hostname);
  return 1;
}

sub generic_resolvconf {
  my $filename = shift;
  my $ns = $ConfigPatcher::Main::vhost{'net'}{'nameserver'};
  s2f($filename, "nameserver $ns");
  return 1;
}

sub generic_hosts {
  my $filename = shift;
  my $hostname = $ConfigPatcher::Main::vhost{'net'}{'hostname'};
  my $domain = $ConfigPatcher::Main::vhost{'net'}{'domain'};
  my $fqhn = $hostname . "." . $domain;
  my $ip = $ConfigPatcher::Main::vhost{'net'}{'ip'};
  rif(
      $filename, 
      { 
      '@@UML_IP@@' => $ip,
      '@@UML_FQHN@@' => $fqhn . " " . $hostname,
      } 
  );
  return 1;
}

sub generic_hosts_ano {

}

sub debian_interfaces {

  my $filename = shift;
  my $ip = $ConfigPatcher::Main::vhost{'net'}{'ip'};
  my $device = $ConfigPatcher::Main::vhost{'net'}{'device'};

# -----------------
my %tmpl;
$tmpl{'in'} = '
auto @@UML_DEVICE@@
iface @@UML_DEVICE@@ inet static
        address @@UML_IP@@
        netmask 255.255.255.255
        network @@UML_IP@@
        broadcast @@UML_IP@@
        gateway @@UML_IP@@
';
$tmpl{'pattern'}{'EntryIdent'}  = 'iface (.+?) ';
$tmpl{'pattern'}{'EntryCheck'}  = 'iface @@KEY@@ ';
# -----------------

  $tmpl{'out'} =
  ris(
      $tmpl{'in'}, 
      { 
      '@@UML_DEVICE@@' => $device,
      '@@UML_IP@@' => $ip,
      } 
  );

  my %chk = %tmpl;
  $chk{'filename'} = $filename;
  $chk{'EntryFound'} = ' ';
  if (isEntryInFile(\%chk)) {
    print "\n", "  an entry specifying \"", $chk{'EntryFound'}, "\" already exists in \"$filename\", will not overwrite!!!  ";
    return 0;
  } else {
    a2f($filename, $tmpl{'out'});
    return 1;
  }

}

sub debian_interfaces_ano {

}

#-----------------------------------
# generic_nuller

sub generic_nuller {
  my $filename = shift;
  my $cmd;
  if ( -f $filename ) { 
    $cmd="> $filename";
    #print "\n", "ccc: ", $cmd, "\n";
    `$cmd`;
    return 1;
  }
  if ( -d $filename ) { 
    my $dirlist = getDirList($filename);
    my @dir = split("\n", $dirlist);
    foreach (@dir) {
      my $path_abs = $filename . '/' . $_;
      if (-f $path_abs) { 
        my $cmd = "> $path_abs"; 
        #print "\n", "ccc: ", $cmd, "\n";
        `$cmd`;
      }
    }
    return 1;
  }
}

#-----------------------------------
# generic_sendmail

sub generic_sendmail {
  my $filename = shift;
  my $hostname = $ConfigPatcher::Main::vhost{'net'}{'hostname'};
  my $domain = $ConfigPatcher::Main::vhost{'net'}{'domain'};
  my $cmd;
  $filename =~ m/.*\/(.+?)$/;
  my $name = $1;
  if ($name eq 'local-host-names') {
    #my $entry = $hostname . '.' . $domain;
    my $entry = $domain;
    s2f($filename, $entry);
    return 1;
  }
  if ($name eq 'relay-domains') {
    my $entry = $domain;
    s2f($filename, $entry);
    return 1;
  }
}

1;
1	joko	1.1	package ConfigPatcher::Handlers;
2
3			use strict;
4			use warnings;
5
6			use UML::Utils;
7
8			sub s2f {
9			my $filename = shift;
10			my $string = shift;
11			open(FH, '>' . $filename);
12			print FH $string;
13			print FH "\n";
14			close(FH);
15			}
16
17			sub f2s {
18			my $filename = shift;
19			# read file at once (be careful with big files!!!)
20			open(FH, '<' . $filename);
21			my @buf_arr = <FH>;
22			my $buf = join("", @buf_arr);
23			close(FH);
24			return $buf;
25			}
26
27			sub a2f {
28			my $filename = shift;
29			my $string = shift;
30			open(FH, '>>' . $filename);
31			print FH "\n";
32			print FH $string;
33			print FH "\n";
34			close(FH);
35			}
36
37			sub ris {
38			my $string = shift;
39			my $rules = shift;
40
41	joko	1.2	our $ris_result = 1;
42
43	joko	1.1	if (ref $rules eq 'HASH') {
44			my @re_find = keys %{$rules};
45			# replace all keys with substitutes from hash "%re_table"
46			foreach my $find (@re_find) {
47			my $replace = $rules->{$find};
48	joko	1.2	$ris_result &= ($string =~ s/$find/$replace/g);
49	joko	1.1	}
50			}
51
52			if (ref $rules eq 'ARRAY') {
53			foreach my $rule (@{$rules}) {
54			my $find = $rule->[0];
55			my $replace = $rule->[1];
56	joko	1.2	$ris_result &= ($string =~ s/$find/$replace/g);
57	joko	1.1	}
58			}
59
60			return $string;
61			}
62
63			sub rif {
64			my $filename = shift;
65			my $rules = shift;
66			my $out_suffix = shift;
67
68			my $outfile = $filename;
69			$outfile .= '.' . $out_suffix if ($out_suffix);
70
71			my $buf = f2s($filename);
72			$buf = ris($buf, $rules);
73			s2f($outfile, $buf);
74			}
75
76			sub findKeyEntries {
77			my $string = shift;
78			my $pattern = shift;
79			my @arr = split("\n", $string);
80			my @entries;
81			foreach (@arr) {
82			chomp;
83			#print "l: ", $_, "\n";
84			if (m/$pattern/) {
85			push @entries, $1;
86			}
87			}
88			return \@entries;
89			}
90
91			# ---------------------------------
92			# is a context-entry in a file?
93			# a "context-entry" is an entry identified
94			# by a certain keystring, which itself
95			# is detected dynamically
96			sub isEntryInFile {
97
98			my $chk = shift;
99			my $content_current = f2s($chk->{filename});
100
101			# try to find all key-entries via patterns which are "entry-identifiers"
102			if (my @keys = @{ findKeyEntries($chk->{'out'}, $chk->{'pattern'}{'EntryIdent'}) }) {
103			# iterate through all "entry-identifiers"
104			foreach (@keys) {
105			my $pattern = $chk->{'pattern'}{'EntryCheck'};
106			$pattern =~ s/\@\@KEY\@\@/$_/;
107			my $bool_AlreadyThere = ($content_current =~ m/$pattern/);
108			if ($bool_AlreadyThere) {
109			$chk->{'EntryFound'} = $_;
110			return 1;
111			}
112			}
113			}
114
115			}
116
117
118
119			sub generic_hostname {
120			my $filename = shift;
121			my $hostname = $ConfigPatcher::Main::vhost{'net'}{'hostname'};
122			s2f($filename, $hostname);
123			return 1;
124			}
125
126			sub generic_resolvconf {
127			my $filename = shift;
128			my $ns = $ConfigPatcher::Main::vhost{'net'}{'nameserver'};
129			s2f($filename, "nameserver $ns");
130			return 1;
131			}
132
133			sub generic_hosts {
134			my $filename = shift;
135			my $hostname = $ConfigPatcher::Main::vhost{'net'}{'hostname'};
136			my $domain = $ConfigPatcher::Main::vhost{'net'}{'domain'};
137			my $fqhn = $hostname . "." . $domain;
138			my $ip = $ConfigPatcher::Main::vhost{'net'}{'ip'};
139			rif(
140			$filename,
141			{
142			'@@UML_IP@@' => $ip,
143			'@@UML_FQHN@@' => $fqhn . " " . $hostname,
144			}
145			);
146			return 1;
147			}
148
149			sub generic_hosts_ano {
150
151			}
152
153			sub debian_interfaces {
154
155			my $filename = shift;
156			my $ip = $ConfigPatcher::Main::vhost{'net'}{'ip'};
157			my $device = $ConfigPatcher::Main::vhost{'net'}{'device'};
158
159			# -----------------
160			my %tmpl;
161			$tmpl{'in'} = '
162			auto @@UML_DEVICE@@
163			iface @@UML_DEVICE@@ inet static
164			address @@UML_IP@@
165			netmask 255.255.255.255
166			network @@UML_IP@@
167			broadcast @@UML_IP@@
168			gateway @@UML_IP@@
169			';
170			$tmpl{'pattern'}{'EntryIdent'} = 'iface (.+?) ';
171			$tmpl{'pattern'}{'EntryCheck'} = 'iface @@KEY@@ ';
172			# -----------------
173
174			$tmpl{'out'} =
175			ris(
176			$tmpl{'in'},
177			{
178			'@@UML_DEVICE@@' => $device,
179			'@@UML_IP@@' => $ip,
180			}
181			);
182
183			my %chk = %tmpl;
184			$chk{'filename'} = $filename;
185			$chk{'EntryFound'} = ' ';
186			if (isEntryInFile(\%chk)) {
187			print "\n", " an entry specifying \"", $chk{'EntryFound'}, "\" already exists in \"$filename\", will not overwrite!!! ";
188			return 0;
189			} else {
190			a2f($filename, $tmpl{'out'});
191			return 1;
192			}
193
194			}
195
196			sub debian_interfaces_ano {
197
198			}
199
200			#-----------------------------------
201			# generic_nuller
202
203			sub generic_nuller {
204			my $filename = shift;
205			my $cmd;
206			if ( -f $filename ) {
207			$cmd="> $filename";
208			#print "\n", "ccc: ", $cmd, "\n";
209			`$cmd`;
210			return 1;
211			}
212			if ( -d $filename ) {
213			my $dirlist = getDirList($filename);
214			my @dir = split("\n", $dirlist);
215			foreach (@dir) {
216			my $path_abs = $filename . '/' . $_;
217			if (-f $path_abs) {
218			my $cmd = "> $path_abs";
219			#print "\n", "ccc: ", $cmd, "\n";
220			`$cmd`;
221			}
222			}
223			return 1;
224			}
225			}
226
227			#-----------------------------------
228			# generic_sendmail
229
230			sub generic_sendmail {
231			my $filename = shift;
232			my $hostname = $ConfigPatcher::Main::vhost{'net'}{'hostname'};
233			my $domain = $ConfigPatcher::Main::vhost{'net'}{'domain'};
234			my $cmd;
235			$filename =~ m/.*\/(.+?)$/;
236			my $name = $1;
237			if ($name eq 'local-host-names') {
238			#my $entry = $hostname . '.' . $domain;
239			my $entry = $domain;
240			s2f($filename, $entry);
241			return 1;
242			}
243			if ($name eq 'relay-domains') {
244			my $entry = $domain;
245			s2f($filename, $entry);
246			return 1;
247			}
248			}
249
250			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26