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 }
56 #=== FUNCTION ================================================================
57 # NAME: create_xml_hash
58 # PARAMETERS: header - string - message header (required)
59 # source - string - where the message come from (required)
60 # target - string - where the message should go to (required)
61 # [header_value] - string - something usefull (optional)
62 # RETURNS: hash - hash - nomen est omen
63 # DESCRIPTION: creates a key-value hash, all values are stored in a array
64 #===============================================================================
65 sub create_xml_hash {
66 my ($header, $source, $target, $header_value) = @_;
67 my $hash = {
68 header => [$header],
69 source => [$source],
70 target => [$target],
71 $header => [$header_value],
72 };
73 return $hash
74 }
77 #=== FUNCTION ================================================================
78 # NAME: create_xml_string
79 # PARAMETERS: xml_hash - hash - hash from function create_xml_hash
80 # RETURNS: xml_string - string - xml string representation of the hash
81 # DESCRIPTION: transform the hash to a string using XML::Simple module
82 #===============================================================================
83 sub create_xml_string {
84 my ($xml_hash) = @_ ;
85 my $xml_string = $xml->XMLout($xml_hash, RootName => 'xml');
86 #$xml_string =~ s/[\n]+//g;
87 #daemon_log("create_xml_string:",7);
88 #daemon_log("$xml_string\n", 7);
89 return $xml_string;
90 }
93 sub transform_msg2hash {
94 my ($msg) = @_ ;
95 my $hash = $xml->XMLin($msg, ForceArray=>1);
97 # xml tags without a content are created as an empty hash
98 # substitute it with an empty list
99 eval {
100 while( my ($xml_tag, $xml_content) = each %{ $hash } ) {
101 if( 1 == @{ $xml_content } ) {
102 # there is only one element in xml_content list ...
103 my $element = @{ $xml_content }[0];
104 if( ref($element) eq "HASH" ) {
105 # and this element is an hash ...
106 my $len_element = keys %{ $element };
107 if( $len_element == 0 ) {
108 # and this hash is empty, then substitute the xml_content
109 # with an empty string in list
110 $hash->{$xml_tag} = [ "none" ];
111 }
112 }
113 }
114 }
115 };
116 if( $@ ) {
117 $hash = undef;
118 }
120 return $hash;
121 }
124 #=== FUNCTION ================================================================
125 # NAME: add_content2xml_hash
126 # PARAMETERS: xml_ref - ref - reference to a hash from function create_xml_hash
127 # element - string - key for the hash
128 # content - string - value for the hash
129 # RETURNS: nothing
130 # DESCRIPTION: add key-value pair to xml_ref, if key alread exists,
131 # then append value to list
132 #===============================================================================
133 sub add_content2xml_hash {
134 my ($xml_ref, $element, $content) = @_;
135 if(not exists $$xml_ref{$element} ) {
136 $$xml_ref{$element} = [];
137 }
138 my $tmp = $$xml_ref{$element};
139 push(@$tmp, $content);
140 return;
141 }
144 #=== FUNCTION ================================================================
145 # NAME: encrypt_msg
146 # PARAMETERS: msg - string - message to encrypt
147 # my_cipher - ref - reference to a Crypt::Rijndael object
148 # RETURNS: crypted_msg - string - crypted message
149 # DESCRIPTION: crypts the incoming message with the Crypt::Rijndael module
150 #===============================================================================
151 sub encrypt_msg {
152 # my ($msg, $my_cipher) = @_;
153 # if(not defined $my_cipher) { print "no cipher object\n"; }
154 # {
155 # use bytes;
156 # $msg = "\0"x(16-length($msg)%16).$msg;
157 # }
158 # $msg = $my_cipher->encrypt($msg);
159 # chomp($msg = &encode_base64($msg));
160 #
161 # # there are no newlines allowed inside msg
162 # $msg=~ s/\n//g;
163 #
164 # return $msg;
165 my ($msg, $key) = @_;
166 my $my_cipher = &create_ciphering($key);
167 {
168 use bytes;
169 $msg = "\0"x(16-length($msg)%16).$msg;
170 }
171 $msg = $my_cipher->encrypt($msg);
172 chomp($msg = &encode_base64($msg));
173 # there are no newlines allowed inside msg
174 $msg=~ s/\n//g;
175 return $msg;
177 }
180 #=== FUNCTION ================================================================
181 # NAME: decrypt_msg
182 # PARAMETERS: crypted_msg - string - message to decrypt
183 # my_cipher - ref - reference to a Crypt::Rijndael object
184 # RETURNS: msg - string - decrypted message
185 # DESCRIPTION: decrypts the incoming message with the Crypt::Rijndael module
186 #===============================================================================
187 sub decrypt_msg {
188 # my ($msg, $my_cipher) = @_ ;
189 #
190 # if(defined $msg && defined $my_cipher) {
191 # $msg = &decode_base64($msg);
192 # }
193 # $msg = $my_cipher->decrypt($msg);
194 # $msg =~ s/\0*//g;
195 # return $msg;
196 my ($msg, $key) = @_ ;
197 $msg = &decode_base64($msg);
198 my $my_cipher = &create_ciphering($key);
199 $msg = $my_cipher->decrypt($msg);
200 $msg =~ s/\0*//g;
201 return $msg;
202 }
205 #=== FUNCTION ================================================================
206 # NAME: create_ciphering
207 # PARAMETERS: passwd - string - used to create ciphering
208 # RETURNS: cipher - object
209 # DESCRIPTION: creates a Crypt::Rijndael::MODE_CBC object with passwd as key
210 #===============================================================================
211 sub create_ciphering {
212 my ($passwd) = @_;
213 $passwd = substr(md5_hex("$passwd") x 32, 0, 32);
214 my $iv = substr(md5_hex('GONICUS GmbH'),0, 16);
216 #daemon_log("iv: $iv", 7);
217 #daemon_log("key: $passwd", 7);
218 my $my_cipher = Crypt::Rijndael->new($passwd , Crypt::Rijndael::MODE_CBC());
219 $my_cipher->set_iv($iv);
220 return $my_cipher;
221 }
224 #=== FUNCTION ================================================================
225 # NAME: open_socket
226 # PARAMETERS: PeerAddr string something like 192.168.1.1 or 192.168.1.1:10000
227 # [PeerPort] string necessary if port not appended by PeerAddr
228 # RETURNS: socket IO::Socket::INET
229 # DESCRIPTION: open a socket to PeerAddr
230 #===============================================================================
231 #sub open_socket {
232 # my ($PeerAddr, $PeerPort) = @_ ;
233 # if(defined($PeerPort)){
234 # $PeerAddr = $PeerAddr.":".$PeerPort;
235 # }
236 # my $socket;
237 # $socket = new IO::Socket::INET(PeerAddr => $PeerAddr,
238 # Porto => "tcp",
239 # Type => SOCK_STREAM,
240 # Timeout => 5,
241 # );
242 # if(not defined $socket) {
243 # return;
244 # }
245 # &daemon_log("open_socket: $PeerAddr", 7);
246 # return $socket;
247 #}
250 sub get_time {
251 my ($seconds, $minutes, $hours, $monthday, $month,
252 $year, $weekday, $yearday, $sommertime) = localtime(time);
253 $hours = $hours < 10 ? $hours = "0".$hours : $hours;
254 $minutes = $minutes < 10 ? $minutes = "0".$minutes : $minutes;
255 $seconds = $seconds < 10 ? $seconds = "0".$seconds : $seconds;
256 $month+=1;
257 $month = $month < 10 ? $month = "0".$month : $month;
258 $monthday = $monthday < 10 ? $monthday = "0".$monthday : $monthday;
259 $year+=1900;
260 return "$year$month$monthday$hours$minutes$seconds";
262 }
265 #=== FUNCTION ================================================================
266 # NAME: build_msg
267 # DESCRIPTION: Send a message to a destination
268 # PARAMETERS: [header] Name of the header
269 # [from] sender ip
270 # [to] recipient ip
271 # [data] Hash containing additional attributes for the xml
272 # package
273 # RETURNS: nothing
274 #===============================================================================
275 sub build_msg ($$$$) {
276 my ($header, $from, $to, $data) = @_;
278 my $out_hash = &create_xml_hash($header, $from, $to);
280 while ( my ($key, $value) = each(%$data) ) {
281 if(ref($value) eq 'ARRAY'){
282 map(&add_content2xml_hash($out_hash, $key, $_), @$value);
283 } else {
284 &add_content2xml_hash($out_hash, $key, $value);
285 }
286 }
287 my $out_msg = &create_xml_string($out_hash);
288 return $out_msg;
289 }
292 sub get_where_statement {
293 my ($msg, $msg_hash) = @_;
294 my $error= 0;
296 my $clause_str= "";
297 if( (not exists $msg_hash->{'where'}) || (not exists @{$msg_hash->{'where'}}[0]->{'clause'}) ) {
298 $error++;
299 }
301 if( $error == 0 ) {
302 my @clause_l;
303 my @where = @{@{$msg_hash->{'where'}}[0]->{'clause'}};
304 foreach my $clause (@where) {
305 my $connector = $clause->{'connector'}[0];
306 if( not defined $connector ) { $connector = "AND"; }
307 $connector = uc($connector);
308 delete($clause->{'connector'});
310 my @phrase_l ;
311 foreach my $phrase (@{$clause->{'phrase'}}) {
312 my $operator = "=";
313 if( exists $phrase->{'operator'} ) {
314 my $op = $op_hash->{$phrase->{'operator'}[0]};
315 if( not defined $op ) {
316 &main::daemon_log("Can not translate operator '$operator' in where ".
317 "statement to sql valid syntax. Please use 'eq', ".
318 "'ne', 'ge', 'gt', 'le', 'lt' in xml message\n", 1);
319 &main::daemon_log($msg, 8);
320 $op = "=";
321 }
322 $operator = $op;
323 delete($phrase->{'operator'});
324 }
326 my @xml_tags = keys %{$phrase};
327 my $tag = $xml_tags[0];
328 my $val = $phrase->{$tag}[0];
329 push(@phrase_l, "$tag$operator'$val'");
330 }
331 my $clause_str .= join(" $connector ", @phrase_l);
332 push(@clause_l, $clause_str);
333 }
335 if( not 0 == @clause_l ) {
336 $clause_str = join(" AND ", @clause_l);
337 $clause_str = "WHERE $clause_str ";
338 }
339 }
341 return $clause_str;
342 }
344 sub get_select_statement {
345 my ($msg, $msg_hash)= @_;
346 my $select = "*";
347 if( exists $msg_hash->{'select'} ) {
348 my $select_l = \@{$msg_hash->{'select'}};
349 $select = join(' AND ', @{$select_l});
350 }
351 return $select;
352 }
355 sub get_update_statement {
356 my ($msg, $msg_hash) = @_;
357 my $error= 0;
358 my $update_str= "";
359 my @update_l;
361 if( not exists $msg_hash->{'update'} ) { $error++; };
363 if( $error == 0 ) {
364 my $update= @{$msg_hash->{'update'}}[0];
365 while( my ($tag, $val) = each %{$update} ) {
366 my $val= @{$update->{$tag}}[0];
367 push(@update_l, "$tag='$val'");
368 }
369 if( 0 == @update_l ) { $error++; };
370 }
372 if( $error == 0 ) {
373 $update_str= join(', ', @update_l);
374 $update_str= "SET $update_str ";
375 }
377 return $update_str;
378 }
380 sub get_limit_statement {
381 my ($msg, $msg_hash)= @_;
382 my $error= 0;
383 my $limit_str = "";
384 my ($from, $to);
386 if( not exists $msg_hash->{'limit'} ) { $error++; };
388 if( $error == 0 ) {
389 eval {
390 my $limit= @{$msg_hash->{'limit'}}[0];
391 $from= @{$limit->{'from'}}[0];
392 $to= @{$limit->{'to'}}[0];
393 };
394 if( $@ ) {
395 $error++;
396 }
397 }
399 if( $error == 0 ) {
400 $limit_str= "LIMIT $from, $to";
401 }
403 return $limit_str;
404 }
406 sub get_orderby_statement {
407 my ($msg, $msg_hash)= @_;
408 my $error= 0;
409 my $order_str= "";
410 my $order;
412 if( not exists $msg_hash->{'orderby'} ) { $error++; };
414 if( $error == 0) {
415 eval {
416 $order= @{$msg_hash->{'orderby'}}[0];
417 };
418 if( $@ ) {
419 $error++;
420 }
421 }
423 if( $error == 0 ) {
424 $order_str= "ORDER BY $order";
425 }
427 return $order_str;
428 }
430 1;