1 package GOSA::GosaSupportDaemon;
3 use strict;
4 use warnings;
6 use Exporter;
7 use IO::Socket::INET;
8 use Crypt::Rijndael;
9 use Digest::MD5 qw(md5 md5_hex md5_base64);
10 use MIME::Base64;
11 use XML::Quote qw(:all);
12 use XML::Simple;
13 use Data::Dumper;
14 use Net::DNS;
15 use Net::ARP;
16 use DateTime;
18 our @ISA = qw(Exporter);
20 my @functions = (
21 "create_passwd",
22 "create_xml_hash",
23 "createXmlHash",
24 "myXmlHashToString",
25 "get_content_from_xml_hash",
26 "add_content2xml_hash",
27 "create_xml_string",
28 "transform_msg2hash",
29 "get_time",
30 "get_utc_time",
31 "build_msg",
32 "db_res2xml",
33 "db_res2si_msg",
34 "get_where_statement",
35 "get_select_statement",
36 "get_update_statement",
37 "get_limit_statement",
38 "get_orderby_statement",
39 "get_dns_domains",
40 "get_server_addresses",
41 "get_logged_in_users",
42 "import_events",
43 "del_doubles",
44 "get_ip",
45 "get_interface_for_ip",
46 "get_interfaces",
47 "get_mac_for_interface",
48 "get_local_ip_for_remote_ip",
49 "is_local",
50 "run_as",
51 "inform_all_other_si_server",
52 "read_configfile",
53 "check_opsi_res",
54 "calc_timestamp",
55 "opsi_callobj2string",
56 );
58 our @EXPORT = @functions;
60 my $op_hash = {
61 'eq' => '=',
62 'ne' => '!=',
63 'ge' => '>=',
64 'gt' => '>',
65 'le' => '<=',
66 'lt' => '<',
67 'like' => ' LIKE ',
68 };
71 BEGIN {}
73 END {}
75 ### Start ######################################################################
77 our $xml = new XML::Simple();
79 sub daemon_log {
80 my ($msg, $level) = @_ ;
81 &main::daemon_log($msg, $level);
82 return;
83 }
86 sub create_passwd {
87 my $new_passwd = "";
88 for(my $i=0; $i<31; $i++) {
89 $new_passwd .= ("a".."z","A".."Z",0..9)[int(rand(62))]
90 }
92 return $new_passwd;
93 }
96 sub del_doubles {
97 my %all;
98 $all{$_}=0 for @_;
99 return (keys %all);
100 }
103 #=== FUNCTION ================================================================
104 # NAME: create_xml_hash
105 # PARAMETERS: header - string - message header (required)
106 # source - string - where the message come from (required)
107 # target - string - where the message should go to (required)
108 # [header_value] - string - something usefull (optional)
109 # RETURNS: hash - hash - nomen est omen
110 # DESCRIPTION: creates a key-value hash, all values are stored in a array
111 #===============================================================================
112 sub create_xml_hash {
113 my ($header, $source, $target, $header_value) = @_;
114 my $hash = {
115 header => [$header],
116 source => [$source],
117 target => [$target],
118 $header => [$header_value],
119 };
120 return $hash
121 }
123 sub createXmlHash {
124 my ($header, $source, $target) = @_;
125 return { header=>$header, source=>$source, target=>$target};
126 }
128 sub _transformHashToString {
129 my ($hash) = @_;
130 my $s = "";
132 while (my ($tag, $content) = each(%$hash)) {
134 if (ref $content eq "HASH") {
135 $s .= "<$tag>".&_transformHashToString($content)."</$tag>";
136 } elsif ( ref $content eq "ARRAY") {
137 $s .= &_transformArrayToString($tag, $content);
138 } else {
139 $content = defined $content ? $content : "";
140 $s .= "<$tag>".&xml_quote($content)."</$tag>";
141 }
142 }
143 return $s;
144 }
146 sub _transformArrayToString {
147 my ($tag, $contentArray) = @_;
148 my $s = "";
149 foreach my $content (@$contentArray) {
150 if (ref $content eq "HASH") {
151 $s .= "<$tag>".&_transformHashToString($content)."</$tag>";
152 } else {
153 $content = defined $content ? $content : "";
154 $s .= "<$tag>".&xml_quote($content)."</$tag>";
155 }
156 }
157 return $s;
158 }
161 #=== FUNCTION ================================================================
162 # NAME: myXmlHashToString
163 # PARAMETERS: xml_hash - hash - hash from function createXmlHash
164 # RETURNS: xml_string - string - xml string representation of the hash
165 # DESCRIPTION: Transforms the given hash to a xml wellformed string. I.e.:
166 # {
167 # 'header' => 'a'
168 # 'source' => 'c',
169 # 'target' => 'b',
170 # 'hit' => [ '1',
171 # '2',
172 # {
173 # 'hit31' => 'ABC',
174 # 'hit32' => 'XYZ'
175 # }
176 # ],
177 # 'res0' => {
178 # 'res1' => {
179 # 'res2' => 'result'
180 # }
181 # },
182 # };
183 #
184 # will be transformed to
185 # <xml>
186 # <header>a</header>
187 # <source>c</source>
188 # <target>b</target>
189 # <hit>1</hit>
190 # <hit>2</hit>
191 # <hit>
192 # <hit31>ABC</hit31>
193 # <hit32>XYZ</hit32>
194 # </hit>
195 # <res0>
196 # <res1>
197 # <res2>result</res2>
198 # </res1>
199 # </res0>
200 # </xml>
201 #
202 #===============================================================================
203 sub myXmlHashToString {
204 my ($hash) = @_;
205 return "<xml>".&_transformHashToString($hash)."</xml>";
206 }
209 #=== FUNCTION ================================================================
210 # NAME: create_xml_string
211 # PARAMETERS: xml_hash - hash - hash from function create_xml_hash
212 # RETURNS: xml_string - string - xml string representation of the hash
213 # DESCRIPTION: transform the hash to a string using XML::Simple module
214 #===============================================================================
215 sub create_xml_string {
216 my ($xml_hash) = @_ ;
217 my $xml_string = $xml->XMLout($xml_hash, RootName => 'xml');
218 #$xml_string =~ s/[\n]+//g;
219 #daemon_log("create_xml_string:",7);
220 #daemon_log("$xml_string\n", 7);
221 return $xml_string;
222 }
225 sub transform_msg2hash {
226 my ($msg) = @_ ;
227 my $hash = $xml->XMLin($msg, ForceArray=>1);
229 # xml tags without a content are created as an empty hash
230 # substitute it with an empty list
231 eval {
232 while( my ($xml_tag, $xml_content) = each %{ $hash } ) {
233 if( 1 == @{ $xml_content } ) {
234 # there is only one element in xml_content list ...
235 my $element = @{ $xml_content }[0];
236 if( ref($element) eq "HASH" ) {
237 # and this element is an hash ...
238 my $len_element = keys %{ $element };
239 if( $len_element == 0 ) {
240 # and this hash is empty, then substitute the xml_content
241 # with an empty string in list
242 $hash->{$xml_tag} = [ "none" ];
243 }
244 }
245 }
246 }
247 };
248 if( $@ ) {
249 $hash = undef;
250 }
252 return $hash;
253 }
256 #=== FUNCTION ================================================================
257 # NAME: add_content2xml_hash
258 # PARAMETERS: xml_ref - ref - reference to a hash from function create_xml_hash
259 # element - string - key for the hash
260 # content - string - value for the hash
261 # RETURNS: nothing
262 # DESCRIPTION: add key-value pair to xml_ref, if key alread exists,
263 # then append value to list
264 #===============================================================================
265 sub add_content2xml_hash {
266 my ($xml_ref, $element, $content) = @_;
267 if(not exists $$xml_ref{$element} ) {
268 $$xml_ref{$element} = [];
269 }
270 my $tmp = $$xml_ref{$element};
271 push(@$tmp, $content);
272 return;
273 }
276 sub get_time {
277 my ($seconds, $minutes, $hours, $monthday, $month,
278 $year, $weekday, $yearday, $sommertime) = localtime;
279 $hours = $hours < 10 ? $hours = "0".$hours : $hours;
280 $minutes = $minutes < 10 ? $minutes = "0".$minutes : $minutes;
281 $seconds = $seconds < 10 ? $seconds = "0".$seconds : $seconds;
282 $month+=1;
283 $month = $month < 10 ? $month = "0".$month : $month;
284 $monthday = $monthday < 10 ? $monthday = "0".$monthday : $monthday;
285 $year+=1900;
286 return "$year$month$monthday$hours$minutes$seconds";
287 }
290 sub get_utc_time {
291 my $utc_time = qx(date --utc +%Y%m%d%H%M%S);
292 $utc_time =~ s/\s$//;
293 return $utc_time;
294 }
297 #=== FUNCTION ================================================================
298 # NAME: build_msg
299 # DESCRIPTION: Send a message to a destination
300 # PARAMETERS: [header] Name of the header
301 # [from] sender ip
302 # [to] recipient ip
303 # [data] Hash containing additional attributes for the xml
304 # package
305 # RETURNS: nothing
306 #===============================================================================
307 sub build_msg ($$$$) {
308 my ($header, $from, $to, $data) = @_;
310 # data is of form, i.e.
311 # %data= ('ip' => $address, 'mac' => $mac);
313 my $out_hash = &create_xml_hash($header, $from, $to);
315 while ( my ($key, $value) = each(%$data) ) {
316 if(ref($value) eq 'ARRAY'){
317 map(&add_content2xml_hash($out_hash, $key, $_), @$value);
318 } else {
319 &add_content2xml_hash($out_hash, $key, $value);
320 }
321 }
322 my $out_msg = &create_xml_string($out_hash);
323 return $out_msg;
324 }
327 sub db_res2xml {
328 my ($db_res) = @_ ;
329 my $xml = "";
331 my $len_db_res= keys %{$db_res};
332 for( my $i= 1; $i<= $len_db_res; $i++ ) {
333 $xml .= "\n<answer$i>";
334 my $hash= $db_res->{$i};
335 while ( my ($column_name, $column_value) = each %{$hash} ) {
336 $xml .= "<$column_name>";
337 my $xml_content;
338 if( $column_name eq "xmlmessage" ) {
339 $xml_content = &encode_base64($column_value);
340 } else {
341 $xml_content = defined $column_value ? $column_value : "";
342 }
343 $xml .= $xml_content;
344 $xml .= "</$column_name>";
345 }
346 $xml .= "</answer$i>";
348 }
350 return $xml;
351 }
354 sub db_res2si_msg {
355 my ($db_res, $header, $target, $source) = @_;
357 my $si_msg = "<xml>";
358 $si_msg .= "<header>$header</header>";
359 $si_msg .= "<source>$source</source>";
360 $si_msg .= "<target>$target</target>";
361 $si_msg .= &db_res2xml;
362 $si_msg .= "</xml>";
363 }
366 sub get_where_statement {
367 my ($msg, $msg_hash) = @_;
368 my $error= 0;
370 my $clause_str= "";
371 if( (not exists $msg_hash->{'where'}) || (not exists @{$msg_hash->{'where'}}[0]->{'clause'}) ) {
372 $error++;
373 }
375 if( $error == 0 ) {
376 my @clause_l;
377 my @where = @{@{$msg_hash->{'where'}}[0]->{'clause'}};
378 foreach my $clause (@where) {
379 my $connector = $clause->{'connector'}[0];
380 if( not defined $connector ) { $connector = "AND"; }
381 $connector = uc($connector);
382 delete($clause->{'connector'});
384 my @phrase_l ;
385 foreach my $phrase (@{$clause->{'phrase'}}) {
386 my $operator = "=";
387 if( exists $phrase->{'operator'} ) {
388 my $op = $op_hash->{$phrase->{'operator'}[0]};
389 if( not defined $op ) {
390 &main::daemon_log("ERROR: Can not translate operator '$operator' in where-".
391 "statement to sql valid syntax. Please use 'eq', ".
392 "'ne', 'ge', 'gt', 'le', 'lt' in xml message\n", 1);
393 &main::daemon_log($msg, 8);
394 $op = "=";
395 }
396 $operator = $op;
397 delete($phrase->{'operator'});
398 }
400 my @xml_tags = keys %{$phrase};
401 my $tag = $xml_tags[0];
402 my $val = $phrase->{$tag}[0];
403 if( ref($val) eq "HASH" ) { next; } # empty xml-tags should not appear in where statement
405 # integer columns do not have to have single quotes besides the value
406 if ($tag eq "id") {
407 push(@phrase_l, "$tag$operator$val");
408 } else {
409 push(@phrase_l, "$tag$operator'$val'");
410 }
411 }
413 if (not 0 == @phrase_l) {
414 my $clause_str .= join(" $connector ", @phrase_l);
415 push(@clause_l, "($clause_str)");
416 }
417 }
419 if( not 0 == @clause_l ) {
420 $clause_str = join(" AND ", @clause_l);
421 $clause_str = "WHERE ($clause_str) ";
422 }
423 }
425 return $clause_str;
426 }
428 sub get_select_statement {
429 my ($msg, $msg_hash)= @_;
430 my $select = "*";
431 if( exists $msg_hash->{'select'} ) {
432 my $select_l = \@{$msg_hash->{'select'}};
433 $select = join(', ', @{$select_l});
434 }
435 return $select;
436 }
439 sub get_update_statement {
440 my ($msg, $msg_hash) = @_;
441 my $error= 0;
442 my $update_str= "";
443 my @update_l;
445 if( not exists $msg_hash->{'update'} ) { $error++; };
447 if( $error == 0 ) {
448 my $update= @{$msg_hash->{'update'}}[0];
449 while( my ($tag, $val) = each %{$update} ) {
450 my $val= @{$update->{$tag}}[0];
451 push(@update_l, "$tag='$val'");
452 }
453 if( 0 == @update_l ) { $error++; };
454 }
456 if( $error == 0 ) {
457 $update_str= join(', ', @update_l);
458 $update_str= "SET $update_str ";
459 }
461 return $update_str;
462 }
464 sub get_limit_statement {
465 my ($msg, $msg_hash)= @_;
466 my $error= 0;
467 my $limit_str = "";
468 my ($from, $to);
470 if( not exists $msg_hash->{'limit'} ) { $error++; };
472 if( $error == 0 ) {
473 eval {
474 my $limit= @{$msg_hash->{'limit'}}[0];
475 $from= @{$limit->{'from'}}[0];
476 $to= @{$limit->{'to'}}[0];
477 };
478 if( $@ ) {
479 $error++;
480 }
481 }
483 if( $error == 0 ) {
484 $limit_str= "LIMIT $from, $to";
485 }
487 return $limit_str;
488 }
490 sub get_orderby_statement {
491 my ($msg, $msg_hash)= @_;
492 my $error= 0;
493 my $order_str= "";
494 my $order;
496 if( not exists $msg_hash->{'orderby'} ) { $error++; };
498 if( $error == 0) {
499 eval {
500 $order= @{$msg_hash->{'orderby'}}[0];
501 };
502 if( $@ ) {
503 $error++;
504 }
505 }
507 if( $error == 0 ) {
508 $order_str= "ORDER BY $order";
509 }
511 return $order_str;
512 }
514 sub get_dns_domains() {
515 my $line;
516 my @searches;
517 open(my $RESOLV, "<", "/etc/resolv.conf") or return @searches;
518 while(<$RESOLV>){
519 $line= $_;
520 chomp $line;
521 $line =~ s/^\s+//;
522 $line =~ s/\s+$//;
523 $line =~ s/\s+/ /;
524 if ($line =~ /^domain (.*)$/ ){
525 push(@searches, $1);
526 } elsif ($line =~ /^search (.*)$/ ){
527 push(@searches, split(/ /, $1));
528 }
529 }
530 close($RESOLV);
532 my %tmp = map { $_ => 1 } @searches;
533 @searches = sort keys %tmp;
535 return @searches;
536 }
539 sub get_server_addresses {
540 my $domain= shift;
541 my @result;
542 my $error_string;
544 my $error = 0;
545 my $res = Net::DNS::Resolver->new;
546 my $query = $res->send("_gosa-si._tcp.".$domain, "SRV");
547 my @hits;
549 if ($query) {
550 foreach my $rr ($query->answer) {
551 push(@hits, $rr->target.":".$rr->port);
552 }
553 }
554 else {
555 $error_string = "determination of '_gosa-si._tcp' server in domain '$domain' failed: ".$res->errorstring;
556 $error++;
557 }
559 if( $error == 0 ) {
560 foreach my $hit (@hits) {
561 my ($hit_name, $hit_port) = split(/:/, $hit);
562 chomp($hit_name);
563 chomp($hit_port);
565 my $address_query = $res->send($hit_name);
566 if( 1 == length($address_query->answer) ) {
567 foreach my $rr ($address_query->answer) {
568 push(@result, $rr->address.":".$hit_port);
569 }
570 }
571 }
572 }
574 return \@result, $error_string;
575 }
578 sub get_logged_in_users {
579 my $result = qx(/usr/bin/w -hs);
580 my @res_lines;
582 if( defined $result ) {
583 chomp($result);
584 @res_lines = split("\n", $result);
585 }
587 my @logged_in_user_list;
588 foreach my $line (@res_lines) {
589 chomp($line);
590 my @line_parts = split(/\s+/, $line);
591 push(@logged_in_user_list, $line_parts[0]);
592 }
594 return @logged_in_user_list;
596 }
599 sub import_events {
600 my ($event_dir) = @_;
601 my $event_hash;
602 my $error = 0;
603 my @result = ();
604 if (not -e $event_dir) {
605 $error++;
606 push(@result, "cannot find directory or directory is not readable: $event_dir");
607 }
609 my $DIR;
610 if ($error == 0) {
611 opendir ($DIR, $event_dir) or do {
612 $error++;
613 push(@result, "cannot open directory '$event_dir' for reading: $!\n");
614 }
615 }
617 if ($error == 0) {
618 while (defined (my $event = readdir ($DIR))) {
619 if( $event eq "." || $event eq ".." || ($event =~ /^\.pm$/)) { next; }
621 # Check config file to exclude disabled event plugins (i.e. Opsi)
622 if ($event eq "opsi_com.pm" && $main::opsi_enabled ne "true") {
623 &main::daemon_log("0 WARNING: opsi-module is installed but not enabled in config file, please set under section '[OPSI]': 'enabled=true'", 3);
624 next;
625 }
627 # try to import event module
628 eval{ require $event; };
629 if( $@ ) {
630 $error++;
631 #push(@result, "import of event module '$event' failed: $@");
632 #next;
634 &main::daemon_log("ERROR: Import of event module '$event' failed: $@",1);
635 exit(1);
636 }
638 # fetch all single events
639 $event =~ /(\S*?).pm$/;
640 my $event_module = $1;
641 my $events_l = eval( $1."::get_events()") ;
642 foreach my $event_name (@{$events_l}) {
643 $event_hash->{$event_module}->{$event_name} = "";
644 }
645 my $events_string = join( ", ", @{$events_l});
646 push(@result, "import of event module '$event' succeed: $events_string");
647 }
649 close $DIR;
650 }
652 return ($error, \@result, $event_hash);
654 }
657 #=== FUNCTION ================================================================
658 # NAME: get_ip
659 # PARAMETERS: interface name (i.e. eth0)
660 # RETURNS: (ip address)
661 # DESCRIPTION: Uses ioctl to get ip address directly from system.
662 #===============================================================================
663 sub get_ip {
664 my $ifreq= shift;
665 my $result= "";
666 my $SIOCGIFADDR= 0x8915; # man 2 ioctl_list
667 my $proto= getprotobyname('ip');
669 socket SOCKET, PF_INET, SOCK_DGRAM, $proto
670 or die "socket: $!";
672 if(ioctl SOCKET, $SIOCGIFADDR, $ifreq) {
673 my ($if, $sin) = unpack 'a16 a16', $ifreq;
674 my ($port, $addr) = sockaddr_in $sin;
675 my $ip = inet_ntoa $addr;
677 if ($ip && length($ip) > 0) {
678 $result = $ip;
679 }
680 }
682 return $result;
683 }
686 #=== FUNCTION ================================================================
687 # NAME: get_interface_for_ip
688 # PARAMETERS: ip address (i.e. 192.168.0.1)
689 # RETURNS: array: list of interfaces if ip=0.0.0.0, matching interface if found, undef else
690 # DESCRIPTION: Uses proc fs (/proc/net/dev) to get list of interfaces.
691 #===============================================================================
692 sub get_interface_for_ip {
693 my $result;
694 my $ip= shift;
696 if($ip =~ /^[a-z]/i) {
697 my $ip_address = inet_ntoa(scalar gethostbyname($ip));
698 if(defined($ip_address) && $ip_address =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/) {
699 # Write ip address to $source variable
700 $ip = $ip_address;
701 }
702 }
704 if ($ip && length($ip) > 0) {
705 my @ifs= &get_interfaces();
706 if($ip eq "0.0.0.0") {
707 $result = "all";
708 } else {
709 foreach (@ifs) {
710 my $if=$_;
711 if(&get_ip($if) eq $ip) {
712 $result = $if;
713 }
714 }
715 }
716 }
717 return $result;
718 }
720 #=== FUNCTION ================================================================
721 # NAME: get_interfaces
722 # PARAMETERS: none
723 # RETURNS: (list of interfaces)
724 # DESCRIPTION: Uses proc fs (/proc/net/dev) to get list of interfaces.
725 #===============================================================================
726 sub get_interfaces {
727 my @result;
728 my $PROC_NET_DEV= ('/proc/net/dev');
730 open(my $FD_PROC_NET_DEV, "<", "$PROC_NET_DEV")
731 or die "Could not open $PROC_NET_DEV";
733 my @ifs = <$FD_PROC_NET_DEV>;
735 close($FD_PROC_NET_DEV);
737 # Eat first two line
738 shift @ifs;
739 shift @ifs;
741 chomp @ifs;
742 foreach my $line(@ifs) {
743 my $if= (split /:/, $line)[0];
744 $if =~ s/^\s+//;
745 push @result, $if;
746 }
748 return @result;
749 }
751 sub get_local_ip_for_remote_ip {
752 my $remote_ip= shift;
753 my $result="0.0.0.0";
755 if($remote_ip =~ /^(\d\d?\d?\.){3}\d\d?\d?$/) {
756 my $PROC_NET_ROUTE= ('/proc/net/route');
758 open(my $FD_PROC_NET_ROUTE, "<", "$PROC_NET_ROUTE")
759 or die "Could not open $PROC_NET_ROUTE";
761 my @ifs = <$FD_PROC_NET_ROUTE>;
763 close($FD_PROC_NET_ROUTE);
765 # Eat header line
766 shift @ifs;
767 chomp @ifs;
768 my $iffallback = '';
770 # linux-vserver might have * as Iface due to hidden interfaces, set a default
771 foreach my $line(@ifs) {
772 my ($Iface,$Destination,$Gateway,$Flags,$RefCnt,$Use,$Metric,$Mask,$MTU,$Window,$IRTT)=split(/\s/, $line);
773 if ($Iface =~ m/^[^\*]+$/) {
774 $iffallback = $Iface;
775 }
776 }
778 foreach my $line(@ifs) {
779 my ($Iface,$Destination,$Gateway,$Flags,$RefCnt,$Use,$Metric,$Mask,$MTU,$Window,$IRTT)=split(/\s/, $line);
780 my $destination;
781 my $mask;
782 my ($d,$c,$b,$a)=unpack('a2 a2 a2 a2', $Destination);
783 if ($Iface =~ m/^[^\*]+$/) {
784 $iffallback = $Iface;
785 }
786 $destination= sprintf("%d.%d.%d.%d", hex($a), hex($b), hex($c), hex($d));
787 ($d,$c,$b,$a)=unpack('a2 a2 a2 a2', $Mask);
788 $mask= sprintf("%d.%d.%d.%d", hex($a), hex($b), hex($c), hex($d));
789 if(new NetAddr::IP($remote_ip)->within(new NetAddr::IP($destination, $mask))) {
790 # destination matches route, save mac and exit
791 #$result= &get_ip($Iface);
793 if ($Iface =~ m/^\*$/ ) {
794 $result= &get_ip($iffallback);
795 } else {
796 $result= &get_ip($Iface);
797 }
798 last;
799 }
800 }
801 }
803 return $result;
804 }
807 sub get_mac_for_interface {
808 my $ifreq= shift;
809 my $result;
810 if ($ifreq && length($ifreq) > 0) {
811 if($ifreq eq "all") {
812 $result = "00:00:00:00:00:00";
813 } else {
814 $result = Net::ARP::get_mac($ifreq);
815 }
816 }
817 return $result;
818 }
821 #=== FUNCTION ================================================================
822 # NAME: is_local
823 # PARAMETERS: Server Address
824 # RETURNS: true if Server Address is on this host, false otherwise
825 # DESCRIPTION: Checks all interface addresses, stops on first match
826 #===============================================================================
827 sub is_local {
828 my $server_address = shift || "";
829 my $result = 0;
831 my $server_ip = $1 if $server_address =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}):\d{1,6}$/;
833 if(defined($server_ip) && length($server_ip) > 0) {
834 foreach my $interface(&get_interfaces()) {
835 my $ip_address= &get_ip($interface);
836 if($ip_address eq $server_ip) {
837 $result = 1;
838 last;
839 }
840 }
841 }
843 return $result;
844 }
847 #=== FUNCTION ================================================================
848 # NAME: run_as
849 # PARAMETERS: uid, command
850 # RETURNS: hash with keys 'resultCode' = resultCode of command and
851 # 'output' = program output
852 # DESCRIPTION: Runs command as uid using the sudo utility.
853 #===============================================================================
854 sub run_as {
855 my ($uid, $command) = @_;
856 my $sudo_cmd = `which sudo`;
857 chomp($sudo_cmd);
858 if(! -x $sudo_cmd) {
859 &main::daemon_log("ERROR: The sudo utility is not available! Please fix this!");
860 }
861 my $cmd_line= "$sudo_cmd su - $uid -c '$command'";
862 open(my $PIPE, "$cmd_line |");
863 my $result = {'command' => $cmd_line};
864 push @{$result->{'output'}}, <$PIPE>;
865 close($PIPE);
866 my $exit_value = $? >> 8;
867 $result->{'resultCode'} = $exit_value;
868 return $result;
869 }
872 #=== FUNCTION ================================================================
873 # NAME: inform_other_si_server
874 # PARAMETERS: message
875 # RETURNS: nothing
876 # DESCRIPTION: Sends message to all other SI-server found in known_server_db.
877 #===============================================================================
878 sub inform_all_other_si_server {
879 my ($msg) = @_;
881 # determine all other si-server from known_server_db
882 my $sql_statement= "SELECT * FROM $main::known_server_tn";
883 my $res = $main::known_server_db->select_dbentry( $sql_statement );
885 while( my ($hit_num, $hit) = each %$res ) {
886 my $act_target_address = $hit->{hostname};
887 my $act_target_key = $hit->{hostkey};
889 # determine the source address corresponding to the actual target address
890 my ($act_target_ip, $act_target_port) = split(/:/, $act_target_address);
891 my $act_source_address = &main::get_local_ip_for_remote_ip($act_target_ip).":$act_target_port";
893 # fill into message the correct target and source addresses
894 my $act_msg = $msg;
895 $act_msg =~ s/<target>\w*<\/target>/<target>$act_target_address<\/target>/g;
896 $act_msg =~ s/<source>\w*<\/source>/<source>$act_source_address<\/source>/g;
898 # send message to the target
899 &main::send_msg_to_target($act_msg, $act_target_address, $act_target_key, "foreign_job_updates" , "J");
900 }
902 return;
903 }
906 sub read_configfile {
907 my ($cfg_file, %cfg_defaults) = @_ ;
908 my $cfg;
909 if( defined( $cfg_file) && ( (-s $cfg_file) > 0 )) {
910 if( -r $cfg_file ) {
911 $cfg = Config::IniFiles->new( -file => $cfg_file, -nocase => 1 );
912 } else {
913 print STDERR "Couldn't read config file!";
914 }
915 } else {
916 $cfg = Config::IniFiles->new() ;
917 }
918 foreach my $section (keys %cfg_defaults) {
919 foreach my $param (keys %{$cfg_defaults{ $section }}) {
920 my $pinfo = $cfg_defaults{ $section }{ $param };
921 ${@$pinfo[ 0 ]} = $cfg->val( $section, $param, @$pinfo[ 1 ] );
922 }
923 }
924 }
927 sub check_opsi_res {
928 my $res= shift;
930 if($res) {
931 if ($res->is_error) {
932 my $error_string;
933 if (ref $res->error_message eq "HASH") {
934 # for different versions
935 $error_string = $res->error_message->{'message'};
936 $_ = $res->error_message->{'message'};
937 } else {
938 # for different versions
939 $error_string = $res->error_message;
940 $_ = $res->error_message;
941 }
942 return 1, $error_string;
943 }
944 } else {
945 # for different versions
946 $_ = $main::opsi_client->status_line;
947 return 1, $main::opsi_client->status_line;
948 }
949 return 0;
950 }
952 sub calc_timestamp {
953 my ($timestamp, $operation, $value, $entity) = @_ ;
954 $entity = defined $entity ? $entity : "seconds";
955 my $res_timestamp = 0;
957 $value = int($value);
958 $timestamp = int($timestamp);
959 $timestamp =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/;
960 my $dt = DateTime->new( year => $1,
961 month => $2,
962 day => $3,
963 hour => $4,
964 minute => $5,
965 second => $6,
966 );
968 if ($operation eq "plus" || $operation eq "+") {
969 $dt->add($entity => $value);
970 $res_timestamp = $dt->ymd('').$dt->hms('');
971 }
973 if ($operation eq "minus" || $operation eq "-") {
974 $dt->subtract($entity => $value);
975 $res_timestamp = $dt->ymd('').$dt->hms('');
976 }
978 return $res_timestamp;
979 }
981 sub opsi_callobj2string {
982 my ($callobj) = @_;
983 my @callobj_string;
984 while(my ($key, $value) = each(%$callobj)) {
985 my $value_string = "";
986 if (ref($value) eq "ARRAY") {
987 $value_string = join(",", @$value);
988 } else {
989 $value_string = $value;
990 }
991 push(@callobj_string, "$key=$value_string")
992 }
993 return join(", ", @callobj_string);
994 }
996 1;