/[cvs]/nfo/perl/scripts/umltools/ConfigPatcher/Handlers.pm
ViewVC logotype

Contents of /nfo/perl/scripts/umltools/ConfigPatcher/Handlers.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Tue Oct 22 02:25:56 2002 UTC (21 years, 7 months ago) by joko
Branch: MAIN
Branch point for: nfo
Initial revision

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 RSS 2.0 feed