Code

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