3a15aa94186b8ee6ea56ebfad0955d08883bf535
1 package GOSA::GosaSupportDaemon;
3 use Exporter;
4 @ISA = qw(Exporter);
5 my @functions = (
6 "create_xml_hash",
7 "get_content_from_xml_hash",
8 "add_content2xml_hash",
9 "create_xml_string",
10 "encrypt_msg",
11 "decrypt_msg",
12 "create_ciphering",
13 "transform_msg2hash",
14 "get_time",
15 "build_msg",
16 "get_where_statement",
17 "get_select_statement",
18 "get_update_statement",
19 "get_limit_statement",
20 "get_orderby_statement",
21 );
22 @EXPORT = @functions;
23 use strict;
24 use warnings;
25 use IO::Socket::INET;
26 use Crypt::Rijndael;
27 use Digest::MD5 qw(md5 md5_hex md5_base64);
28 use MIME::Base64;
29 use XML::Simple;
31 my $op_hash = {
32 'eq' => '=',
33 'ne' => '!=',
34 'ge' => '>=',
35 'gt' => '>',
36 'le' => '<=',
37 'lt' => '<',
38 };
41 BEGIN {}
43 END {}
45 ### Start ######################################################################
47 my $xml = new XML::Simple();
49 sub daemon_log {
50 my ($msg, $level) = @_ ;
51 &main::daemon_log($msg, $level);
52 return;
53 }
58 #=== FUNCTION ================================================================
59 # NAME: create_xml_hash
60 # PARAMETERS: header - string - message header (required)
61 # source - string - where the message come from (required)
62 # target - string - where the message should go to (required)
63 # [header_value] - string - something usefull (optional)
64 # RETURNS: hash - hash - nomen est omen
65 # DESCRIPTION: creates a key-value hash, all values are stored in a array
66 #===============================================================================
67 sub create_xml_hash {
68 my ($header, $source, $target, $header_value) = @_;
69 my $hash = {
70 header => [$header],
71 source => [$source],
72 target => [$target],
73 $header => [$header_value],
74 };
75 return $hash
76 }
79 #=== FUNCTION ================================================================
80 # NAME: create_xml_string
81 # PARAMETERS: xml_hash - hash - hash from function create_xml_hash
82 # RETURNS: xml_string - string - xml string representation of the hash
83 # DESCRIPTION: transform the hash to a string using XML::Simple module
84 #===============================================================================
85 sub create_xml_string {
86 my ($xml_hash) = @_ ;
87 my $xml_string = $xml->XMLout($xml_hash, RootName => 'xml');
88 #$xml_string =~ s/[\n]+//g;
89 #daemon_log("create_xml_string:",7);
90 #daemon_log("$xml_string\n", 7);
91 return $xml_string;
92 }
95 sub transform_msg2hash {
96 my ($msg) = @_ ;
97 my $hash = $xml->XMLin($msg, ForceArray=>1);
99 # xml tags without a content are created as an empty hash
100 # substitute it with an empty list
101 eval {
102 while( my ($xml_tag, $xml_content) = each %{ $hash } ) {
103 if( 1 == @{ $xml_content } ) {
104 # there is only one element in xml_content list ...
105 my $element = @{ $xml_content }[0];
106 if( ref($element) eq "HASH" ) {
107 # and this element is an hash ...
108 my $len_element = keys %{ $element };
109 if( $len_element == 0 ) {
110 # and this hash is empty, then substitute the xml_content
111 # with an empty string in list
112 $hash->{$xml_tag} = [ "none" ];
113 }
114 }
115 }
116 }
117 };
118 if( $@ ) {
119 $hash = undef;
120 }
122 return $hash;
123 }
126 #=== FUNCTION ================================================================
127 # NAME: add_content2xml_hash
128 # PARAMETERS: xml_ref - ref - reference to a hash from function create_xml_hash
129 # element - string - key for the hash
130 # content - string - value for the hash
131 # RETURNS: nothing
132 # DESCRIPTION: add key-value pair to xml_ref, if key alread exists,
133 # then append value to list
134 #===============================================================================
135 sub add_content2xml_hash {
136 my ($xml_ref, $element, $content) = @_;
137 if(not exists $$xml_ref{$element} ) {
138 $$xml_ref{$element} = [];
139 }
140 my $tmp = $$xml_ref{$element};
141 push(@$tmp, $content);
142 return;
143 }
146 #=== FUNCTION ================================================================
147 # NAME: encrypt_msg
148 # PARAMETERS: msg - string - message to encrypt
149 # my_cipher - ref - reference to a Crypt::Rijndael object
150 # RETURNS: crypted_msg - string - crypted message
151 # DESCRIPTION: crypts the incoming message with the Crypt::Rijndael module
152 #===============================================================================
153 sub encrypt_msg {
154 # my ($msg, $my_cipher) = @_;
155 # if(not defined $my_cipher) { print "no cipher object\n"; }
156 # {
157 # use bytes;
158 # $msg = "\0"x(16-length($msg)%16).$msg;
159 # }
160 # $msg = $my_cipher->encrypt($msg);
161 # chomp($msg = &encode_base64($msg));
162 #
163 # # there are no newlines allowed inside msg
164 # $msg=~ s/\n//g;
165 #
166 # return $msg;
167 my ($msg, $key) = @_;
168 my $my_cipher = &create_ciphering($key);
169 {
170 use bytes;
171 $msg = "\0"x(16-length($msg)%16).$msg;
172 }
173 $msg = $my_cipher->encrypt($msg);
174 chomp($msg = &encode_base64($msg));
175 # there are no newlines allowed inside msg
176 $msg=~ s/\n//g;
177 return $msg;
179 }
182 #=== FUNCTION ================================================================
183 # NAME: decrypt_msg
184 # PARAMETERS: crypted_msg - string - message to decrypt
185 # my_cipher - ref - reference to a Crypt::Rijndael object
186 # RETURNS: msg - string - decrypted message
187 # DESCRIPTION: decrypts the incoming message with the Crypt::Rijndael module
188 #===============================================================================
189 sub decrypt_msg {
190 # my ($msg, $my_cipher) = @_ ;
191 #
192 # if(defined $msg && defined $my_cipher) {
193 # $msg = &decode_base64($msg);
194 # }
195 # $msg = $my_cipher->decrypt($msg);
196 # $msg =~ s/\0*//g;
197 # return $msg;
198 my ($msg, $key) = @_ ;
199 $msg = &decode_base64($msg);
200 my $my_cipher = &create_ciphering($key);
201 $msg = $my_cipher->decrypt($msg);
202 $msg =~ s/\0*//g;
203 return $msg;
204 }
207 #=== FUNCTION ================================================================
208 # NAME: create_ciphering
209 # PARAMETERS: passwd - string - used to create ciphering
210 # RETURNS: cipher - object
211 # DESCRIPTION: creates a Crypt::Rijndael::MODE_CBC object with passwd as key
212 #===============================================================================
213 sub create_ciphering {
214 my ($passwd) = @_;
215 $passwd = substr(md5_hex("$passwd") x 32, 0, 32);
216 my $iv = substr(md5_hex('GONICUS GmbH'),0, 16);
218 #daemon_log("iv: $iv", 7);
219 #daemon_log("key: $passwd", 7);
220 my $my_cipher = Crypt::Rijndael->new($passwd , Crypt::Rijndael::MODE_CBC());
221 $my_cipher->set_iv($iv);
222 return $my_cipher;
223 }
226 #=== FUNCTION ================================================================
227 # NAME: open_socket
228 # PARAMETERS: PeerAddr string something like 192.168.1.1 or 192.168.1.1:10000
229 # [PeerPort] string necessary if port not appended by PeerAddr
230 # RETURNS: socket IO::Socket::INET
231 # DESCRIPTION: open a socket to PeerAddr
232 #===============================================================================
233 #sub open_socket {
234 # my ($PeerAddr, $PeerPort) = @_ ;
235 # if(defined($PeerPort)){
236 # $PeerAddr = $PeerAddr.":".$PeerPort;
237 # }
238 # my $socket;
239 # $socket = new IO::Socket::INET(PeerAddr => $PeerAddr,
240 # Porto => "tcp",
241 # Type => SOCK_STREAM,
242 # Timeout => 5,
243 # );
244 # if(not defined $socket) {
245 # return;
246 # }
247 # &daemon_log("open_socket: $PeerAddr", 7);
248 # return $socket;
249 #}
252 sub get_time {
253 my ($seconds, $minutes, $hours, $monthday, $month,
254 $year, $weekday, $yearday, $sommertime) = localtime(time);
255 $hours = $hours < 10 ? $hours = "0".$hours : $hours;
256 $minutes = $minutes < 10 ? $minutes = "0".$minutes : $minutes;
257 $seconds = $seconds < 10 ? $seconds = "0".$seconds : $seconds;
258 $month+=1;
259 $month = $month < 10 ? $month = "0".$month : $month;
260 $monthday = $monthday < 10 ? $monthday = "0".$monthday : $monthday;
261 $year+=1900;
262 return "$year$month$monthday$hours$minutes$seconds";
264 }
267 #=== FUNCTION ================================================================
268 # NAME: build_msg
269 # DESCRIPTION: Send a message to a destination
270 # PARAMETERS: [header] Name of the header
271 # [from] sender ip
272 # [to] recipient ip
273 # [data] Hash containing additional attributes for the xml
274 # package
275 # RETURNS: nothing
276 #===============================================================================
277 sub build_msg ($$$$) {
278 my ($header, $from, $to, $data) = @_;
280 my $out_hash = &create_xml_hash($header, $from, $to);
282 while ( my ($key, $value) = each(%$data) ) {
283 if(ref($value) eq 'ARRAY'){
284 map(&add_content2xml_hash($out_hash, $key, $_), @$value);
285 } else {
286 &add_content2xml_hash($out_hash, $key, $value);
287 }
288 }
289 my $out_msg = &create_xml_string($out_hash);
290 return $out_msg;
291 }
294 sub get_where_statement {
295 my ($msg, $msg_hash) = @_;
296 my $error= 0;
298 my $clause_str= "";
299 if( (not exists $msg_hash->{'where'}) || (not exists @{$msg_hash->{'where'}}[0]->{'clause'}) ) {
300 $error++;
301 }
303 if( $error == 0 ) {
304 my @clause_l;
305 my @where = @{@{$msg_hash->{'where'}}[0]->{'clause'}};
306 foreach my $clause (@where) {
307 my $connector = $clause->{'connector'}[0];
308 if( not defined $connector ) { $connector = "AND"; }
309 $connector = uc($connector);
310 delete($clause->{'connector'});
312 my @phrase_l ;
313 foreach my $phrase (@{$clause->{'phrase'}}) {
314 my $operator = "=";
315 if( exists $phrase->{'operator'} ) {
316 my $op = $op_hash->{$phrase->{'operator'}[0]};
317 if( not defined $op ) {
318 &main::daemon_log("Can not translate operator '$operator' in where ".
319 "statement to sql valid syntax. Please use 'eq', ".
320 "'ne', 'ge', 'gt', 'le', 'lt' in xml message\n", 1);
321 &main::daemon_log($msg, 8);
322 $op = "=";
323 }
324 $operator = $op;
325 delete($phrase->{'operator'});
326 }
328 my @xml_tags = keys %{$phrase};
329 my $tag = $xml_tags[0];
330 my $val = $phrase->{$tag}[0];
331 push(@phrase_l, "$tag$operator'$val'");
332 }
333 my $clause_str .= join(" $connector ", @phrase_l);
334 push(@clause_l, $clause_str);
335 }
337 if( not 0 == @clause_l ) {
338 $clause_str = join(" AND ", @clause_l);
339 $clause_str = "WHERE $clause_str ";
340 }
341 }
343 return $clause_str;
344 }
346 sub get_select_statement {
347 my ($msg, $msg_hash)= @_;
348 my $select = "*";
349 if( exists $msg_hash->{'select'} ) {
350 my $select_l = \@{$msg_hash->{'select'}};
351 $select = join(' AND ', @{$select_l});
352 }
353 return $select;
354 }
357 sub get_update_statement {
358 my ($msg, $msg_hash) = @_;
359 my $error= 0;
360 my $update_str= "";
361 my @update_l;
363 if( not exists $msg_hash->{'update'} ) { $error++; };
365 if( $error == 0 ) {
366 my $update= @{$msg_hash->{'update'}}[0];
367 while( my ($tag, $val) = each %{$update} ) {
368 my $val= @{$update->{$tag}}[0];
369 push(@update_l, "$tag='$val'");
370 }
371 if( 0 == @update_l ) { $error++; };
372 }
374 if( $error == 0 ) {
375 $update_str= join(', ', @update_l);
376 $update_str= "SET $update_str ";
377 }
379 return $update_str;
380 }
382 sub get_limit_statement {
383 my ($msg, $msg_hash)= @_;
384 my $error= 0;
385 my $limit_str = "";
386 my ($from, $to);
388 if( not exists $msg_hash->{'limit'} ) { $error++; };
390 if( $error == 0 ) {
391 eval {
392 my $limit= @{$msg_hash->{'limit'}}[0];
393 $from= @{$limit->{'from'}}[0];
394 $to= @{$limit->{'to'}}[0];
395 };
396 if( $@ ) {
397 $error++;
398 }
399 }
401 if( $error == 0 ) {
402 $limit_str= "LIMIT $from, $to";
403 }
405 return $limit_str;
406 }
408 sub get_orderby_statement {
409 my ($msg, $msg_hash)= @_;
410 my $error= 0;
411 my $order_str= "";
412 my $order;
414 if( not exists $msg_hash->{'orderby'} ) { $error++; };
416 if( $error == 0) {
417 eval {
418 $order= @{$msg_hash->{'orderby'}}[0];
419 };
420 if( $@ ) {
421 $error++;
422 }
423 }
425 if( $error == 0 ) {
426 $order_str= "ORDER BY $order";
427 }
429 return $order_str;
430 }
432 1;