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; |