Code

interface change for periodical jobs
[gosa.git] / gosa-si / modules / GosaSupportDaemon.pm
1 package GOSA::GosaSupportDaemon;
3 use Exporter;
4 @ISA = qw(Exporter);
5 my @functions = (
6     "create_passwd",
7     "create_xml_hash",
8     "get_content_from_xml_hash",
9     "add_content2xml_hash",
10     "create_xml_string",
11     "transform_msg2hash",
12     "get_time",
13     "get_utc_time",
14     "build_msg",
15     "db_res2xml",
16     "db_res2si_msg",
17     "get_where_statement",
18     "get_select_statement",
19     "get_update_statement",
20     "get_limit_statement",
21     "get_orderby_statement",
22     "get_dns_domains",
23     "get_server_addresses",
24     "get_logged_in_users",
25     "import_events",
26     "del_doubles",
27     "get_ip",
28     "get_interface_for_ip",
29     "get_interfaces",
30     "get_mac_for_interface",
31     "get_local_ip_for_remote_ip",
32     "is_local",
33     "run_as",
34     "inform_all_other_si_server",
35     "read_configfile",
36     "check_opsi_res",
37     "calc_timestamp",
38     "opsi_callobj2string",
39     ); 
40 @EXPORT = @functions;
41 use strict;
42 use warnings;
43 use IO::Socket::INET;
44 use Crypt::Rijndael;
45 use Digest::MD5  qw(md5 md5_hex md5_base64);
46 use MIME::Base64;
47 use XML::Simple;
48 use Data::Dumper;
49 use Net::DNS;
50 use DateTime;
53 my $op_hash = {
54     'eq' => '=',
55     'ne' => '!=',
56     'ge' => '>=',
57     'gt' => '>',
58     'le' => '<=',
59     'lt' => '<',
60     'like' => ' LIKE ',
61 };
64 BEGIN {}
66 END {}
68 ### Start ######################################################################
70 my $xml = new XML::Simple();
72 sub daemon_log {
73     my ($msg, $level) = @_ ;
74     &main::daemon_log($msg, $level);
75     return;
76 }
79 sub create_passwd {
80     my $new_passwd = "";
81     for(my $i=0; $i<31; $i++) {
82         $new_passwd .= ("a".."z","A".."Z",0..9)[int(rand(62))]
83     }
85     return $new_passwd;
86 }
89 sub del_doubles { 
90     my %all; 
91     $all{$_}=0 for @_; 
92     return (keys %all); 
93 }
96 #===  FUNCTION  ================================================================
97 #         NAME:  create_xml_hash
98 #   PARAMETERS:  header - string - message header (required)
99 #                source - string - where the message come from (required)
100 #                target - string - where the message should go to (required)
101 #                [header_value] - string - something usefull (optional)
102 #      RETURNS:  hash - hash - nomen est omen
103 #  DESCRIPTION:  creates a key-value hash, all values are stored in a array
104 #===============================================================================
105 sub create_xml_hash {
106     my ($header, $source, $target, $header_value) = @_;
107     my $hash = {
108             header => [$header],
109             source => [$source],
110             target => [$target],
111             $header => [$header_value],
112     };
113     return $hash
117 #===  FUNCTION  ================================================================
118 #         NAME:  create_xml_string
119 #   PARAMETERS:  xml_hash - hash - hash from function create_xml_hash
120 #      RETURNS:  xml_string - string - xml string representation of the hash
121 #  DESCRIPTION:  transform the hash to a string using XML::Simple module
122 #===============================================================================
123 sub create_xml_string {
124     my ($xml_hash) = @_ ;
125     my $xml_string = $xml->XMLout($xml_hash, RootName => 'xml');
126     #$xml_string =~ s/[\n]+//g;
127     #daemon_log("create_xml_string:",7);
128     #daemon_log("$xml_string\n", 7);
129     return $xml_string;
133 sub transform_msg2hash {
134     my ($msg) = @_ ;
135     my $hash = $xml->XMLin($msg, ForceArray=>1);
136     
137     # xml tags without a content are created as an empty hash
138     # substitute it with an empty list
139     eval {
140         while( my ($xml_tag, $xml_content) = each %{ $hash } ) {
141             if( 1 == @{ $xml_content } ) {
142                 # there is only one element in xml_content list ...
143                 my $element = @{ $xml_content }[0];
144                 if( ref($element) eq "HASH" ) {
145                     # and this element is an hash ...
146                     my $len_element = keys %{ $element };
147                     if( $len_element == 0 ) {
148                         # and this hash is empty, then substitute the xml_content
149                         # with an empty string in list
150                         $hash->{$xml_tag} = [ "none" ];
151                     }
152                 }
153             }
154         }
155     };
156     if( $@ ) {  
157         $hash = undef;
158     }
160     return $hash;
164 #===  FUNCTION  ================================================================
165 #         NAME:  add_content2xml_hash
166 #   PARAMETERS:  xml_ref - ref - reference to a hash from function create_xml_hash
167 #                element - string - key for the hash
168 #                content - string - value for the hash
169 #      RETURNS:  nothing
170 #  DESCRIPTION:  add key-value pair to xml_ref, if key alread exists, 
171 #                then append value to list
172 #===============================================================================
173 sub add_content2xml_hash {
174     my ($xml_ref, $element, $content) = @_;
175     if(not exists $$xml_ref{$element} ) {
176         $$xml_ref{$element} = [];
177     }
178     my $tmp = $$xml_ref{$element};
179     push(@$tmp, $content);
180     return;
184 sub get_time {
185         my ($seconds, $minutes, $hours, $monthday, $month,
186                 $year, $weekday, $yearday, $sommertime) = localtime;
187         $hours = $hours < 10 ? $hours = "0".$hours : $hours;
188         $minutes = $minutes < 10 ? $minutes = "0".$minutes : $minutes;
189         $seconds = $seconds < 10 ? $seconds = "0".$seconds : $seconds;
190         $month+=1;
191         $month = $month < 10 ? $month = "0".$month : $month;
192         $monthday = $monthday < 10 ? $monthday = "0".$monthday : $monthday;
193         $year+=1900;
194         return "$year$month$monthday$hours$minutes$seconds";
198 sub get_utc_time {
199     my $utc_time = qx(date --utc +%Y%m%d%H%M%S);
200     $utc_time =~ s/\s$//;
201     return $utc_time;
205 #===  FUNCTION  ================================================================
206 #         NAME: build_msg
207 #  DESCRIPTION: Send a message to a destination
208 #   PARAMETERS: [header] Name of the header
209 #               [from]   sender ip
210 #               [to]     recipient ip
211 #               [data]   Hash containing additional attributes for the xml
212 #                        package
213 #      RETURNS:  nothing
214 #===============================================================================
215 sub build_msg ($$$$) {
216         my ($header, $from, $to, $data) = @_;
218     # data is of form, i.e.
219     # %data= ('ip' => $address, 'mac' => $mac);
221         my $out_hash = &create_xml_hash($header, $from, $to);
223         while ( my ($key, $value) = each(%$data) ) {
224                 if(ref($value) eq 'ARRAY'){
225                         map(&add_content2xml_hash($out_hash, $key, $_), @$value);
226                 } else {
227                         &add_content2xml_hash($out_hash, $key, $value);
228                 }
229         }
230     my $out_msg = &create_xml_string($out_hash);
231     return $out_msg;
235 sub db_res2xml {
236     my ($db_res) = @_ ;
237     my $xml = "";
239     my $len_db_res= keys %{$db_res};
240     for( my $i= 1; $i<= $len_db_res; $i++ ) {
241         $xml .= "\n<answer$i>";
242         my $hash= $db_res->{$i};
243         while ( my ($column_name, $column_value) = each %{$hash} ) {
244             $xml .= "<$column_name>";
245             my $xml_content;
246             if( $column_name eq "xmlmessage" ) {
247                 $xml_content = &encode_base64($column_value);
248             } else {
249                 $xml_content = defined $column_value ? $column_value : "";
250             }
251             $xml .= $xml_content;
252             $xml .= "</$column_name>"; 
253         }
254         $xml .= "</answer$i>";
256     }
258     return $xml;
262 sub db_res2si_msg {
263     my ($db_res, $header, $target, $source) = @_;
265     my $si_msg = "<xml>";
266     $si_msg .= "<header>$header</header>";
267     $si_msg .= "<source>$source</source>";
268     $si_msg .= "<target>$target</target>";
269     $si_msg .= &db_res2xml;
270     $si_msg .= "</xml>";
274 sub get_where_statement {
275     my ($msg, $msg_hash) = @_;
276     my $error= 0;
277     
278     my $clause_str= "";
279     if( (not exists $msg_hash->{'where'}) || (not exists @{$msg_hash->{'where'}}[0]->{'clause'}) ) { 
280         $error++; 
281     }
283     if( $error == 0 ) {
284         my @clause_l;
285         my @where = @{@{$msg_hash->{'where'}}[0]->{'clause'}};
286         foreach my $clause (@where) {
287             my $connector = $clause->{'connector'}[0];
288             if( not defined $connector ) { $connector = "AND"; }
289             $connector = uc($connector);
290             delete($clause->{'connector'});
292             my @phrase_l ;
293             foreach my $phrase (@{$clause->{'phrase'}}) {
294                 my $operator = "=";
295                 if( exists $phrase->{'operator'} ) {
296                     my $op = $op_hash->{$phrase->{'operator'}[0]};
297                     if( not defined $op ) {
298                         &main::daemon_log("ERROR: Can not translate operator '$operator' in where-".
299                                 "statement to sql valid syntax. Please use 'eq', ".
300                                 "'ne', 'ge', 'gt', 'le', 'lt' in xml message\n", 1);
301                         &main::daemon_log($msg, 8);
302                         $op = "=";
303                     }
304                     $operator = $op;
305                     delete($phrase->{'operator'});
306                 }
308                 my @xml_tags = keys %{$phrase};
309                 my $tag = $xml_tags[0];
310                 my $val = $phrase->{$tag}[0];
311                 if( ref($val) eq "HASH" ) { next; }  # empty xml-tags should not appear in where statement
313                                 # integer columns do not have to have single quotes besides the value
314                                 if ($tag eq "id") {
315                                                 push(@phrase_l, "$tag$operator$val");
316                                 } else {
317                                                 push(@phrase_l, "$tag$operator'$val'");
318                                 }
319             }
321             if (not 0 == @phrase_l) {
322                 my $clause_str .= join(" $connector ", @phrase_l);
323                 push(@clause_l, "($clause_str)");
324             }
325         }
327         if( not 0 == @clause_l ) {
328             $clause_str = join(" AND ", @clause_l);
329             $clause_str = "WHERE ($clause_str) ";
330         }
331     }
333     return $clause_str;
336 sub get_select_statement {
337     my ($msg, $msg_hash)= @_;
338     my $select = "*";
339     if( exists $msg_hash->{'select'} ) {
340         my $select_l = \@{$msg_hash->{'select'}};
341         $select = join(', ', @{$select_l});
342     }
343     return $select;
347 sub get_update_statement {
348     my ($msg, $msg_hash) = @_;
349     my $error= 0;
350     my $update_str= "";
351     my @update_l; 
353     if( not exists $msg_hash->{'update'} ) { $error++; };
355     if( $error == 0 ) {
356         my $update= @{$msg_hash->{'update'}}[0];
357         while( my ($tag, $val) = each %{$update} ) {
358             my $val= @{$update->{$tag}}[0];
359             push(@update_l, "$tag='$val'");
360         }
361         if( 0 == @update_l ) { $error++; };   
362     }
364     if( $error == 0 ) { 
365         $update_str= join(', ', @update_l);
366         $update_str= "SET $update_str ";
367     }
369     return $update_str;
372 sub get_limit_statement {
373     my ($msg, $msg_hash)= @_; 
374     my $error= 0;
375     my $limit_str = "";
376     my ($from, $to);
378     if( not exists $msg_hash->{'limit'} ) { $error++; };
380     if( $error == 0 ) {
381         eval {
382             my $limit= @{$msg_hash->{'limit'}}[0];
383             $from= @{$limit->{'from'}}[0];
384             $to= @{$limit->{'to'}}[0];
385         };
386         if( $@ ) {
387             $error++;
388         }
389     }
391     if( $error == 0 ) {
392         $limit_str= "LIMIT $from, $to";
393     }   
394     
395     return $limit_str;
398 sub get_orderby_statement {
399     my ($msg, $msg_hash)= @_;
400     my $error= 0;
401     my $order_str= "";
402     my $order;
403     
404     if( not exists $msg_hash->{'orderby'} ) { $error++; };
406     if( $error == 0) {
407         eval {
408             $order= @{$msg_hash->{'orderby'}}[0];
409         };
410         if( $@ ) {
411             $error++;
412         }
413     }
415     if( $error == 0 ) {
416         $order_str= "ORDER BY $order";   
417     }
418     
419     return $order_str;
422 sub get_dns_domains() {
423         my $line;
424         my @searches;
425         open(RESOLV, "</etc/resolv.conf") or return @searches;
426         while(<RESOLV>){
427                 $line= $_;
428                 chomp $line;
429                 $line =~ s/^\s+//;
430                 $line =~ s/\s+$//;
431                 $line =~ s/\s+/ /;
432                 if ($line =~ /^domain (.*)$/ ){
433                         push(@searches, $1);
434                 } elsif ($line =~ /^search (.*)$/ ){
435                         push(@searches, split(/ /, $1));
436                 }
437         }
438         close(RESOLV);
440         my %tmp = map { $_ => 1 } @searches;
441         @searches = sort keys %tmp;
443         return @searches;
447 sub get_server_addresses {
448     my $domain= shift;
449     my @result;
450     my $error_string;
452     my $error = 0;
453     my $res   = Net::DNS::Resolver->new;
454     my $query = $res->send("_gosa-si._tcp.".$domain, "SRV");
455     my @hits;
457     if ($query) {
458         foreach my $rr ($query->answer) {
459             push(@hits, $rr->target.":".$rr->port);
460         }
461     }
462     else {
463         $error_string = "determination of '_gosa-si._tcp' server in domain '$domain' failed: ".$res->errorstring;
464         $error++;
465     }
467     if( $error == 0 ) {
468         foreach my $hit (@hits) {
469             my ($hit_name, $hit_port) = split(/:/, $hit);
470             chomp($hit_name);
471             chomp($hit_port);
473             my $address_query = $res->send($hit_name);
474             if( 1 == length($address_query->answer) ) {
475                 foreach my $rr ($address_query->answer) {
476                     push(@result, $rr->address.":".$hit_port);
477                 }
478             }
479         }
480     }
482     return \@result, $error_string;
486 sub get_logged_in_users {
487     my $result = qx(/usr/bin/w -hs);
488     my @res_lines;
490     if( defined $result ) { 
491         chomp($result);
492         @res_lines = split("\n", $result);
493     }
495     my @logged_in_user_list;
496     foreach my $line (@res_lines) {
497         chomp($line);
498         my @line_parts = split(/\s+/, $line); 
499         push(@logged_in_user_list, $line_parts[0]);
500     }
502     return @logged_in_user_list;
507 sub import_events {
508     my ($event_dir) = @_;
509     my $event_hash;
510     my $error = 0;
511     my @result = ();
512     if (not -e $event_dir) {
513         $error++;
514         push(@result, "cannot find directory or directory is not readable: $event_dir");   
515     }
517     my $DIR;
518     if ($error == 0) {
519         opendir ($DIR, $event_dir) or do { 
520             $error++;
521             push(@result, "cannot open directory '$event_dir' for reading: $!\n");
522         }
523     }
525     if ($error == 0) {
526         while (defined (my $event = readdir ($DIR))) {
527             if( $event eq "." || $event eq ".." || ($event =~ /^\.pm$/)) { next; }  
529                         # Check config file to exclude disabled event plugins (i.e. Opsi)
530                         if ($event eq "opsi_com.pm" &&  $main::opsi_enabled ne "true")  { 
531                                 &main::daemon_log("0 WARNING: opsi-module is installed but not enabled in config file, please set under section '[OPSI]': 'enabled=true'", 3);  
532                                 next; 
533                         }
535             # try to import event module
536             eval{ require $event; };
537             if( $@ ) {
538                 $error++;
539                 #push(@result, "import of event module '$event' failed: $@");
540                 #next;
541                 
542                 &main::daemon_log("ERROR: Import of event module '$event' failed: $@",1);
543                 exit(1);
544             }
546             # fetch all single events
547             $event =~ /(\S*?).pm$/;
548             my $event_module = $1;
549             my $events_l = eval( $1."::get_events()") ;
550             foreach my $event_name (@{$events_l}) {
551                 $event_hash->{$event_module}->{$event_name} = "";
552             }
553             my $events_string = join( ", ", @{$events_l});
554             push(@result, "import of event module '$event' succeed: $events_string");
555         }
556         
557         close $DIR;
558     }
560     return ($error, \@result, $event_hash);
565 #===  FUNCTION  ================================================================
566 #         NAME:  get_ip 
567 #   PARAMETERS:  interface name (i.e. eth0)
568 #      RETURNS:  (ip address) 
569 #  DESCRIPTION:  Uses ioctl to get ip address directly from system.
570 #===============================================================================
571 sub get_ip {
572         my $ifreq= shift;
573         my $result= "";
574         my $SIOCGIFADDR= 0x8915;       # man 2 ioctl_list
575         my $proto= getprotobyname('ip');
577         socket SOCKET, PF_INET, SOCK_DGRAM, $proto
578                 or die "socket: $!";
580         if(ioctl SOCKET, $SIOCGIFADDR, $ifreq) {
581                 my ($if, $sin)    = unpack 'a16 a16', $ifreq;
582                 my ($port, $addr) = sockaddr_in $sin;
583                 my $ip            = inet_ntoa $addr;
585                 if ($ip && length($ip) > 0) {
586                         $result = $ip;
587                 }
588         }
590         return $result;
594 #===  FUNCTION  ================================================================
595 #         NAME:  get_interface_for_ip
596 #   PARAMETERS:  ip address (i.e. 192.168.0.1)
597 #      RETURNS:  array: list of interfaces if ip=0.0.0.0, matching interface if found, undef else
598 #  DESCRIPTION:  Uses proc fs (/proc/net/dev) to get list of interfaces.
599 #===============================================================================
600 sub get_interface_for_ip {
601         my $result;
602         my $ip= shift;
603         if ($ip && length($ip) > 0) {
604                 my @ifs= &get_interfaces();
605                 if($ip eq "0.0.0.0") {
606                         $result = "all";
607                 } else {
608                         foreach (@ifs) {
609                                 my $if=$_;
610                                 if(&get_ip($if) eq $ip) {
611                                         $result = $if;
612                                 }
613                         }       
614                 }
615         }       
616         return $result;
619 #===  FUNCTION  ================================================================
620 #         NAME:  get_interfaces 
621 #   PARAMETERS:  none
622 #      RETURNS:  (list of interfaces) 
623 #  DESCRIPTION:  Uses proc fs (/proc/net/dev) to get list of interfaces.
624 #===============================================================================
625 sub get_interfaces {
626         my @result;
627         my $PROC_NET_DEV= ('/proc/net/dev');
629         open(PROC_NET_DEV, "<$PROC_NET_DEV")
630                 or die "Could not open $PROC_NET_DEV";
632         my @ifs = <PROC_NET_DEV>;
634         close(PROC_NET_DEV);
636         # Eat first two line
637         shift @ifs;
638         shift @ifs;
640         chomp @ifs;
641         foreach my $line(@ifs) {
642                 my $if= (split /:/, $line)[0];
643                 $if =~ s/^\s+//;
644                 push @result, $if;
645         }
647         return @result;
650 sub get_local_ip_for_remote_ip {
651         my $remote_ip= shift;
652         my $result="0.0.0.0";
654     if($remote_ip =~ /^(\d\d?\d?\.){3}\d\d?\d?$/) {
655         my $PROC_NET_ROUTE= ('/proc/net/route');
657         open(PROC_NET_ROUTE, "<$PROC_NET_ROUTE")
658             or die "Could not open $PROC_NET_ROUTE";
660         my @ifs = <PROC_NET_ROUTE>;
662         close(PROC_NET_ROUTE);
664         # Eat header line
665         shift @ifs;
666         chomp @ifs;
667         my $iffallback = ''; 
669         # linux-vserver might have * as Iface due to hidden interfaces, set a default 
670         foreach my $line(@ifs) { 
671             my ($Iface,$Destination,$Gateway,$Flags,$RefCnt,$Use,$Metric,$Mask,$MTU,$Window,$IRTT)=split(/\s/, $line); 
672             if ($Iface =~ m/^[^\*]+$/) { 
673                  $iffallback = $Iface; 
674             } 
675         }
676  
677         foreach my $line(@ifs) {
678             my ($Iface,$Destination,$Gateway,$Flags,$RefCnt,$Use,$Metric,$Mask,$MTU,$Window,$IRTT)=split(/\s/, $line);
679             my $destination;
680             my $mask;
681             my ($d,$c,$b,$a)=unpack('a2 a2 a2 a2', $Destination);
682             if ($Iface =~ m/^[^\*]+$/) { 
683                  $iffallback = $Iface;
684             } 
685             $destination= sprintf("%d.%d.%d.%d", hex($a), hex($b), hex($c), hex($d));
686             ($d,$c,$b,$a)=unpack('a2 a2 a2 a2', $Mask);
687             $mask= sprintf("%d.%d.%d.%d", hex($a), hex($b), hex($c), hex($d));
688             if(new NetAddr::IP($remote_ip)->within(new NetAddr::IP($destination, $mask))) {
689                 # destination matches route, save mac and exit
690                 #$result= &get_ip($Iface);
692                 if ($Iface =~ m/^\*$/ ) { 
693                     $result= &get_ip($iffallback);    
694                 } else { 
695                     $result= &get_ip($Iface); 
696                 } 
697                 last;
698             }
699         }
700     } 
702         return $result;
706 sub get_mac_for_interface {
707         my $ifreq= shift;
708         my $result;
709         if ($ifreq && length($ifreq) > 0) { 
710                 if($ifreq eq "all") {
711                         $result = "00:00:00:00:00:00";
712                 } else {
713                         my $SIOCGIFHWADDR= 0x8927;     # man 2 ioctl_list
715                         # A configured MAC Address should always override a guessed value
716                         if ($main::server_mac_address and length($main::server_mac_address) > 0) {
717                                 $result= $main::server_mac_address;
718                         }
720                         socket SOCKET, PF_INET, SOCK_DGRAM, getprotobyname('ip')
721                                 or die "socket: $!";
723                         if(ioctl SOCKET, $SIOCGIFHWADDR, $ifreq) {
724                                 my ($if, $mac)= unpack 'h36 H12', $ifreq;
726                                 if (length($mac) > 0) {
727                                         $mac=~ m/^([0-9a-f][0-9a-f])([0-9a-f][0-9a-f])([0-9a-f][0-9a-f])([0-9a-f][0-9a-f])([0-9a-f][0-9a-f])([0-9a-f][0-9a-f])$/;
728                                         $mac= sprintf("%s:%s:%s:%s:%s:%s", $1, $2, $3, $4, $5, $6);
729                                         $result = $mac;
730                                 }
731                         }
732                 }
733         }
734         return $result;
738 #===  FUNCTION  ================================================================
739 #         NAME:  is_local
740 #   PARAMETERS:  Server Address
741 #      RETURNS:  true if Server Address is on this host, false otherwise
742 #  DESCRIPTION:  Checks all interface addresses, stops on first match
743 #===============================================================================
744 sub is_local {
745     my $server_address = shift || "";
746     my $result = 0;
748     my $server_ip = $1 if $server_address =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}):\d{1,6}$/;
750     if(defined($server_ip) && length($server_ip) > 0) {
751         foreach my $interface(&get_interfaces()) {
752             my $ip_address= &get_ip($interface);
753             if($ip_address eq $server_ip) {
754                 $result = 1;
755                 last;
756             }
757         }
758     }
760     return $result;
764 #===  FUNCTION  ================================================================
765 #         NAME:  run_as
766 #   PARAMETERS:  uid, command
767 #      RETURNS:  hash with keys 'resultCode' = resultCode of command and 
768 #                'output' = program output
769 #  DESCRIPTION:  Runs command as uid using the sudo utility.
770 #===============================================================================
771 sub run_as {
772         my ($uid, $command) = @_;
773         my $sudo_cmd = `which sudo`;
774         chomp($sudo_cmd);
775         if(! -x $sudo_cmd) {
776                 &main::daemon_log("ERROR: The sudo utility is not available! Please fix this!");
777         }
778         my $cmd_line= "$sudo_cmd su - $uid -c '$command'";
779         open(PIPE, "$cmd_line |");
780         my $result = {'command' => $cmd_line};
781         push @{$result->{'output'}}, <PIPE>;
782         close(PIPE);
783         my $exit_value = $? >> 8;
784         $result->{'resultCode'} = $exit_value;
785         return $result;
789 #===  FUNCTION  ================================================================
790 #         NAME:  inform_other_si_server
791 #   PARAMETERS:  message
792 #      RETURNS:  nothing
793 #  DESCRIPTION:  Sends message to all other SI-server found in known_server_db. 
794 #===============================================================================
795 sub inform_all_other_si_server {
796     my ($msg) = @_;
798     # determine all other si-server from known_server_db
799     my $sql_statement= "SELECT * FROM $main::known_server_tn";
800     my $res = $main::known_server_db->select_dbentry( $sql_statement ); 
802     while( my ($hit_num, $hit) = each %$res ) {    
803         my $act_target_address = $hit->{hostname};
804         my $act_target_key = $hit->{hostkey};
806         # determine the source address corresponding to the actual target address
807         my ($act_target_ip, $act_target_port) = split(/:/, $act_target_address);
808         my $act_source_address = &main::get_local_ip_for_remote_ip($act_target_ip).":$act_target_port";
810         # fill into message the correct target and source addresses
811         my $act_msg = $msg;
812         $act_msg =~ s/<target>\w*<\/target>/<target>$act_target_address<\/target>/g;
813         $act_msg =~ s/<source>\w*<\/source>/<source>$act_source_address<\/source>/g;
815         # send message to the target
816         &main::send_msg_to_target($act_msg, $act_target_address, $act_target_key, "foreign_job_updates" , "J");
817     }
819     return;
823 sub read_configfile {
824     my ($cfg_file, %cfg_defaults) = @_ ;
825     my $cfg;
826     if( defined( $cfg_file) && ( (-s $cfg_file) > 0 )) {
827         if( -r $cfg_file ) {
828             $cfg = Config::IniFiles->new( -file => $cfg_file, -nocase => 1 );
829         } else {
830             print STDERR "Couldn't read config file!";
831         }
832     } else {
833         $cfg = Config::IniFiles->new() ;
834     }
835     foreach my $section (keys %cfg_defaults) {
836         foreach my $param (keys %{$cfg_defaults{ $section }}) {
837             my $pinfo = $cfg_defaults{ $section }{ $param };
838            ${@$pinfo[ 0 ]} = $cfg->val( $section, $param, @$pinfo[ 1 ] );
839         }
840     }
844 sub check_opsi_res {
845     my $res= shift;
847     if($res) {
848         if ($res->is_error) {
849             my $error_string;
850             if (ref $res->error_message eq "HASH") { 
851                 $error_string = $res->error_message->{'message'}; 
852             } else { 
853                 $error_string = $res->error_message; 
854             }
855             return 1, $error_string;
856         }
857     } else {
858         return 1, $main::opsi_client->status_line;
859     }
860     return 0;
863 sub calc_timestamp {
864     my ($timestamp, $operation, $value, $entity) = @_ ;
865         $entity = defined $entity ? $entity : "seconds";
866     my $res_timestamp = 0;
867     
868     $value = int($value);
869     $timestamp = int($timestamp);
870     $timestamp =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/;
871     my $dt = DateTime->new( year   => $1,
872             month  => $2,
873             day    => $3,
874             hour   => $4,
875             minute => $5,
876             second => $6,
877             );
879     if ($operation eq "plus" || $operation eq "+") {
880         $dt->add($entity => $value);
881         $res_timestamp = $dt->ymd('').$dt->hms('');
882     }
884     if ($operation eq "minus" || $operation eq "-") {
885         $dt->subtract($entity => $value);
886         $res_timestamp = $dt->ymd('').$dt->hms('');
887     }
889     return $res_timestamp;
892 sub opsi_callobj2string {
893     my ($callobj) = @_;
894     my @callobj_string;
895     while(my ($key, $value) = each(%$callobj)) {
896         my $value_string = "";
897         if (ref($value) eq "ARRAY") {
898             $value_string = join(",", @$value);
899         } else {
900             $value_string = $value;
901         }
902         push(@callobj_string, "$key=$value_string")
903     }
904     return join(", ", @callobj_string);
907 1;