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;

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