9b0374de264db0b450c8f716dd700f741b50a421
1 #!/usr/bin/perl
2 #===============================================================================
3 #
4 # FILE: gosa-server
5 #
6 # USAGE: gosa-si-client
7 #
8 # DESCRIPTION:
9 #
10 # OPTIONS: ---
11 # REQUIREMENTS: libnetaddr-ip-perl
12 # BUGS: ---
13 # NOTES:
14 # AUTHOR: (Andreas Rettenberger), <rettenberger@gonicus.de>
15 # COMPANY:
16 # VERSION: 1.0
17 # CREATED: 12.09.2007 08:54:41 CEST
18 # REVISION: ---
19 #===============================================================================
21 use strict;
22 use warnings;
23 use Getopt::Long;
24 use Config::IniFiles;
25 use POSIX;
26 use Time::HiRes qw( gettimeofday );
28 use POE qw(Component::Server::TCP);
29 use IO::Socket::INET;
30 use NetAddr::IP;
31 use Data::Dumper;
32 use Crypt::Rijndael;
33 use GOSA::GosaSupportDaemon;
34 use Digest::MD5 qw(md5_hex md5 md5_base64);
35 use MIME::Base64;
36 use XML::Simple;
37 use Net::DNS;
38 use File::Basename;
40 my $event_dir = "/usr/lib/gosa-si/client/events";
41 use lib "/usr/lib/gosa-si/client/events";
43 my ($cfg_file, %cfg_defaults, $foreground, $verbose, $pid_file, $opts_file, $procid, $pid, $log_file, $fai_logpath);
44 my ($server_ip, $server_port, $server_key, $server_timeout, $server_domain, $server_key_lifetime);
45 my ($client_ip, $client_port, $client_mac_address, $ldap_enabled, $ldap_config, $pam_config, $nss_config);
46 my $xml;
47 my $default_server_key;
48 my $event_hash;
49 my @servers;
50 my $gotoHardwareChecksum;
51 $verbose= 1;
53 # globalise variables which are used in imported events
54 our $cfg_file;
55 our $server_address;
56 our $client_address;
57 our $server_key;
59 # default variables
60 our $REGISTERED = 0;
62 # in function register_at_gosa_si_server, after which period of seconds a new registration should be tried if a registration was
63 # not successful until now
64 my $delay_set_time = 5;
65 our $prg= basename($0);
67 %cfg_defaults = (
68 "general" =>
69 {"log-file" => [\$log_file, "/var/run/".$prg.".log"],
70 "pid-file" => [\$pid_file, "/var/run/".$prg.".pid"],
71 "opts-file" => [\$opts_file, "/var/run/".$prg.".opts"],
72 },
73 "client" =>
74 {"port" => [\$client_port, "20083"],
75 "ip" => [\$client_ip, "0.0.0.0"],
76 "mac-address" => [\$client_mac_address, "00:00:00:00:00:00"],
77 "server-domain" => [\$server_domain, ""],
78 "ldap" => [\$ldap_enabled, 1],
79 "ldap-config" => [\$ldap_config, "/etc/ldap/ldap.conf"],
80 "pam-config" => [\$pam_config, "/etc/pam_ldap.conf"],
81 "nss-config" => [\$nss_config, "/etc/libnss_ldap.conf"],
82 "fai-logpath" => [\$fai_logpath, "/var/log/fai/fai.log"],
83 },
84 "server" => {
85 "ip" => [\$server_ip, "127.0.0.1"],
86 "port" => [\$server_port, "20081"],
87 "key" => [\$server_key, ""],
88 "timeout" => [\$server_timeout, 10],
89 "key-lifetime" => [\$server_key_lifetime, 600],
90 },
92 );
95 #=== FUNCTIONS = functions =====================================================
97 #=== FUNCTION ================================================================
98 # NAME: check_cmdline_param
99 # PARAMETERS:
100 # RETURNS:
101 # DESCRIPTION:
102 #===============================================================================
103 sub check_cmdline_param () {
104 my $err_config;
105 my $err_counter = 0;
106 if(not defined($cfg_file)) {
107 $cfg_file = "/etc/gosa-si/client.conf";
108 if(! -r $cfg_file) {
109 $err_config = "please specify a config file";
110 $err_counter += 1;
111 }
112 }
113 if( $err_counter > 0 ) {
114 &usage( "", 1 );
115 if( defined( $err_config)) { print STDERR "$err_config\n"}
116 print STDERR "\n";
117 exit( -1 );
118 }
119 }
122 #=== FUNCTION ================================================================
123 # NAME: read_configfile
124 # PARAMETERS: cfg_file - string -
125 # RETURNS:
126 # DESCRIPTION:
127 #===============================================================================
128 sub read_configfile {
129 my ($cfg_file, %cfg_defaults) = @_ ;
130 my $cfg;
131 if( defined( $cfg_file) && ( length($cfg_file) > 0 )) {
132 if( -r $cfg_file ) {
133 $cfg = Config::IniFiles->new( -file => $cfg_file );
134 } else {
135 print STDERR "Couldn't read config file!";
136 }
137 } else {
138 $cfg = Config::IniFiles->new() ;
139 }
140 foreach my $section (keys %cfg_defaults) {
141 foreach my $param (keys %{$cfg_defaults{ $section }}) {
142 my $pinfo = $cfg_defaults{ $section }{ $param };
143 ${@$pinfo[ 0 ]} = $cfg->val( $section, $param, @$pinfo[ 1 ] );
144 }
145 }
146 }
149 #=== FUNCTION ================================================================
150 # NAME: check_pid
151 # PARAMETERS:
152 # RETURNS:
153 # DESCRIPTION:
154 #===============================================================================
155 sub check_pid {
156 $pid = -1;
157 # Check, if we are already running
158 if( open(LOCK_FILE, "<$pid_file") ) {
159 $pid = <LOCK_FILE>;
160 if( defined $pid ) {
161 chomp( $pid );
162 if( -f "/proc/$pid/stat" ) {
163 my($stat) = `cat /proc/$pid/stat` =~ m/$pid \((.+)\).*/;
164 if( $0 eq $stat ) {
165 close( LOCK_FILE );
166 exit -1;
167 }
168 }
169 }
170 close( LOCK_FILE );
171 unlink( $pid_file );
172 }
174 # create a syslog msg if it is not to possible to open PID file
175 if (not sysopen(LOCK_FILE, $pid_file, O_WRONLY|O_CREAT|O_EXCL, 0644)) {
176 my($msg) = "Couldn't obtain lockfile '$pid_file' ";
177 if (open(LOCK_FILE, '<', $pid_file)
178 && ($pid = <LOCK_FILE>))
179 {
180 chomp($pid);
181 $msg .= "(PID $pid)\n";
182 } else {
183 $msg .= "(unable to read PID)\n";
184 }
185 if( ! ($foreground) ) {
186 openlog( $0, "cons,pid", "daemon" );
187 syslog( "warning", $msg );
188 closelog();
189 }
190 else {
191 print( STDERR " $msg " );
192 }
193 exit( -1 );
194 }
195 }
198 #=== FUNCTION ================================================================
199 # NAME: logging
200 # PARAMETERS: level - string - default 'info'
201 # msg - string -
202 # facility - string - default 'LOG_DAEMON'
203 # RETURNS:
204 # DESCRIPTION:
205 #===============================================================================
206 sub daemon_log {
207 # log into log_file
208 my( $msg, $level ) = @_;
209 if(not defined $msg) { return }
210 if(not defined $level) { $level = 1 }
211 if(defined $log_file){
212 open(LOG_HANDLE, ">>$log_file");
213 if(not defined open( LOG_HANDLE, ">>$log_file" )) {
214 print STDERR "cannot open $log_file: $!";
215 return }
216 chomp($msg);
217 if($level <= $verbose){
218 my ($seconds, $minutes, $hours, $monthday, $month,
219 $year, $weekday, $yearday, $sommertime) = localtime(time);
220 $hours = $hours < 10 ? $hours = "0".$hours : $hours;
221 $minutes = $minutes < 10 ? $minutes = "0".$minutes : $minutes;
222 $seconds = $seconds < 10 ? $seconds = "0".$seconds : $seconds;
223 my @monthnames = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
224 $month = $monthnames[$month];
225 $monthday = $monthday < 10 ? $monthday = "0".$monthday : $monthday;
226 $year+=1900;
228 my $log_msg = "$month $monthday $hours:$minutes:$seconds $prg $msg\n";
229 print LOG_HANDLE $log_msg;
230 if( $foreground ) {
231 print STDERR $log_msg;
232 }
233 }
234 close( LOG_HANDLE );
235 }
236 #log into syslog
237 # my ($msg, $level, $facility) = @_;
238 # if(not defined $msg) {return}
239 # if(not defined $level) {$level = "info"}
240 # if(not defined $facility) {$facility = "LOG_DAEMON"}
241 # openlog($0, "pid,cons,", $facility);
242 # syslog($level, $msg);
243 # closelog;
244 # return;
245 }
248 #=== FUNCTION ================================================================
249 # NAME: get_interfaces
250 # PARAMETERS: none
251 # RETURNS: (list of interfaces)
252 # DESCRIPTION: Uses proc fs (/proc/net/dev) to get list of interfaces.
253 #===============================================================================
254 sub get_interfaces {
255 my @result;
256 my $PROC_NET_DEV= ('/proc/net/dev');
258 open(PROC_NET_DEV, "<$PROC_NET_DEV")
259 or die "Could not open $PROC_NET_DEV";
261 my @ifs = <PROC_NET_DEV>;
263 close(PROC_NET_DEV);
265 # Eat first two line
266 shift @ifs;
267 shift @ifs;
269 chomp @ifs;
270 foreach my $line(@ifs) {
271 my $if= (split /:/, $line)[0];
272 $if =~ s/^\s+//;
273 push @result, $if;
274 }
276 return @result;
277 }
279 #=== FUNCTION ================================================================
280 # NAME: get_mac
281 # PARAMETERS: interface name (i.e. eth0)
282 # RETURNS: (mac address)
283 # DESCRIPTION: Uses ioctl to get mac address directly from system.
284 #===============================================================================
285 sub get_mac {
286 my $ifreq= shift;
287 my $result;
288 if ($ifreq && length($ifreq) > 0) {
289 if($ifreq eq "all") {
290 if(defined($server_ip)) {
291 $result = &get_local_mac_for_remote_ip($server_ip);
292 }
293 elsif ($client_mac_address && length($client_mac_address) > 0 && !($client_mac_address eq "00:00:00:00:00:00")){
294 $result = &client_mac_address;
295 }
296 else {
297 $result = "00:00:00:00:00:00";
298 }
299 } else {
300 my $SIOCGIFHWADDR= 0x8927; # man 2 ioctl_list
302 # A configured MAC Address should always override a guessed value
303 if ($client_mac_address and length($client_mac_address) > 0 and not($client_mac_address eq "00:00:00:00:00:00")) {
304 $result= $client_mac_address;
305 }
306 else {
307 socket SOCKET, PF_INET, SOCK_DGRAM, getprotobyname('ip')
308 or die "socket: $!";
310 if(ioctl SOCKET, $SIOCGIFHWADDR, $ifreq) {
311 my ($if, $mac)= unpack 'h36 H12', $ifreq;
313 if (length($mac) > 0) {
314 $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])$/;
315 $mac= sprintf("%s:%s:%s:%s:%s:%s", $1, $2, $3, $4, $5, $6);
316 $result = $mac;
317 }
318 }
319 }
320 }
321 }
322 return $result;
323 }
326 #=== FUNCTION ================================================================
327 # NAME: get_interface_for_ip
328 # PARAMETERS: ip address (i.e. 192.168.0.1)
329 # RETURNS: array: list of interfaces if ip=0.0.0.0, matching interface if found, undef else
330 # DESCRIPTION: Uses proc fs (/proc/net/dev) to get list of interfaces.
331 #===============================================================================
332 sub get_interface_for_ip {
333 my $result;
334 my $ip= shift;
335 if ($ip && length($ip) > 0) {
336 my @ifs= &get_interfaces();
337 if($ip eq "0.0.0.0") {
338 $result = "all";
339 } else {
340 foreach (@ifs) {
341 my $if=$_;
342 if(get_ip($if) eq $ip) {
343 $result = $if;
344 last;
345 }
346 }
347 }
348 }
349 return $result;
350 }
353 #=== FUNCTION ================================================================
354 # NAME: get_ip
355 # PARAMETERS: interface name (i.e. eth0)
356 # RETURNS: (ip address)
357 # DESCRIPTION: Uses ioctl to get ip address directly from system.
358 #===============================================================================
359 sub get_ip {
360 my $ifreq= shift;
361 my $result= "";
362 my $SIOCGIFADDR= 0x8915; # man 2 ioctl_list
363 my $proto= getprotobyname('ip');
365 socket SOCKET, PF_INET, SOCK_DGRAM, $proto
366 or die "socket: $!";
368 if(ioctl SOCKET, $SIOCGIFADDR, $ifreq) {
369 my ($if, $sin) = unpack 'a16 a16', $ifreq;
370 my ($port, $addr) = sockaddr_in $sin;
371 my $ip = inet_ntoa $addr;
373 if ($ip && length($ip) > 0) {
374 $result = $ip;
375 }
376 }
378 return $result;
379 }
382 #=== FUNCTION ================================================================
383 # NAME: get_local_mac_for_remote_ip
384 # PARAMETERS: none (takes server_ip from global variable)
385 # RETURNS: (ip address from interface that is used for communication)
386 # DESCRIPTION: Uses ioctl to get routing table from system, checks which entry
387 # matches (defaultroute last).
388 #===============================================================================
389 sub get_local_mac_for_remote_ip {
390 my $server_ip= shift;
391 my $result= "00:00:00:00:00:00";
393 if($server_ip =~ /^(\d\d?\d?\.){3}\d\d?\d?$/) {
394 my $PROC_NET_ROUTE= ('/proc/net/route');
396 open(PROC_NET_ROUTE, "<$PROC_NET_ROUTE")
397 or die "Could not open $PROC_NET_ROUTE";
399 my @ifs = <PROC_NET_ROUTE>;
401 close(PROC_NET_ROUTE);
403 # Eat header line
404 shift @ifs;
405 chomp @ifs;
406 foreach my $line(@ifs) {
407 my ($Iface,$Destination,$Gateway,$Flags,$RefCnt,$Use,$Metric,$Mask,$MTU,$Window,$IRTT)=split(/\s/, $line);
408 my $destination;
409 my $mask;
410 my ($d,$c,$b,$a)=unpack('a2 a2 a2 a2', $Destination);
411 $destination= sprintf("%d.%d.%d.%d", hex($a), hex($b), hex($c), hex($d));
412 ($d,$c,$b,$a)=unpack('a2 a2 a2 a2', $Mask);
413 $mask= sprintf("%d.%d.%d.%d", hex($a), hex($b), hex($c), hex($d));
414 if(new NetAddr::IP($server_ip)->within(new NetAddr::IP($destination, $mask))) {
415 # destination matches route, save mac and exit
416 $result= &get_mac($Iface);
417 last;
418 }
419 }
420 } else {
421 daemon_log("get_local_mac_for_remote_ip was called with a non-ip parameter: $server_ip", 1);
422 }
423 return $result;
424 }
426 sub get_local_ip_for_remote_ip {
427 my $server_ip= shift;
428 my $result="0.0.0.0";
430 if($server_ip =~ /^(\d\d?\d?\.){3}\d\d?\d?$/) {
431 if($server_ip eq "127.0.0.1") {
432 $result="127.0.0.1";
433 } else {
434 my $PROC_NET_ROUTE= ('/proc/net/route');
436 open(PROC_NET_ROUTE, "<$PROC_NET_ROUTE")
437 or die "Could not open $PROC_NET_ROUTE";
439 my @ifs = <PROC_NET_ROUTE>;
441 close(PROC_NET_ROUTE);
443 # Eat header line
444 shift @ifs;
445 chomp @ifs;
446 foreach my $line(@ifs) {
447 my ($Iface,$Destination,$Gateway,$Flags,$RefCnt,$Use,$Metric,$Mask,$MTU,$Window,$IRTT)=split(/\s/, $line);
448 my $destination;
449 my $mask;
450 my ($d,$c,$b,$a)=unpack('a2 a2 a2 a2', $Destination);
451 $destination= sprintf("%d.%d.%d.%d", hex($a), hex($b), hex($c), hex($d));
452 ($d,$c,$b,$a)=unpack('a2 a2 a2 a2', $Mask);
453 $mask= sprintf("%d.%d.%d.%d", hex($a), hex($b), hex($c), hex($d));
454 if(new NetAddr::IP($server_ip)->within(new NetAddr::IP($destination, $mask))) {
455 # destination matches route, save mac and exit
456 $result= &get_ip($Iface);
457 last;
458 }
459 }
460 }
461 } else {
462 daemon_log("get_local_ip_for_remote_ip was called with a non-ip parameter: $server_ip", 1);
463 }
464 return $result;
465 }
467 sub new_ldap_config {
468 my ($msg_hash) = @_ ;
469 my $element;
470 my @ldap_uris;
471 my $ldap_base;
472 my @ldap_options;
473 my @pam_options;
474 my @nss_options;
475 my $goto_admin;
476 my $goto_secret;
477 my $admin_base= "";
478 my $department= "";
479 my $release= "";
480 my $unit_tag;
482 # Transform input into array
483 while ( my ($key, $value) = each(%$msg_hash) ) {
484 if ($key =~ /^(source|target|header)$/) {
485 next;
486 }
488 foreach $element (@$value) {
489 if ($key =~ /^ldap_uri$/) {
490 push (@ldap_uris, $element);
491 next;
492 }
493 if ($key =~ /^ldap_base$/) {
494 $ldap_base= $element;
495 next;
496 }
497 if ($key =~ /^goto_admin$/) {
498 $goto_admin= $element;
499 next;
500 }
501 if ($key =~ /^goto_secret$/) {
502 $goto_secret= $element;
503 next;
504 }
505 if ($key =~ /^ldap_cfg$/) {
506 push (@ldap_options, "$element");
507 next;
508 }
509 if ($key =~ /^pam_cfg$/) {
510 push (@pam_options, "$element");
511 next;
512 }
513 if ($key =~ /^nss_cfg$/) {
514 push (@nss_options, "$element");
515 next;
516 }
517 if ($key =~ /^admin_base$/) {
518 $admin_base= $element;
519 next;
520 }
521 if ($key =~ /^department$/) {
522 $department= $element;
523 next;
524 }
525 if ($key =~ /^unit_tag$/) {
526 $unit_tag= $element;
527 next;
528 }
529 if ($key =~ /^release$/) {
530 $release= $element;
531 next;
532 }
533 }
534 }
536 # Unit tagging enabled?
537 if (defined $unit_tag){
538 push (@pam_options, "pam_filter gosaUnitTag=$unit_tag");
539 push (@nss_options, "nss_base_passwd $admin_base?sub?gosaUnitTag=$unit_tag");
540 push (@nss_options, "nss_base_group $admin_base?sub?gosaUnitTag=$unit_tag");
541 }
543 # Setup ldap.conf
544 my $file1;
545 my $file2;
546 open(file1, "> $ldap_config");
547 print file1 "# This file was automatically generated by gosa-si-client. Do not change.\n";
548 print file1 "URI";
549 foreach $element (@ldap_uris) {
550 print file1 " $element";
551 }
552 print file1 "\nBASE $ldap_base\n";
553 foreach $element (@ldap_options) {
554 print file1 "$element\n";
555 }
556 close (file1);
557 daemon_log("wrote $ldap_config", 5);
559 # Setup pam_ldap.conf / libnss_ldap.conf
560 open(file1, "> $pam_config");
561 open(file2, "> $nss_config");
562 print file1 "# This file was automatically generated by gosa-si-client. Do not change.\n";
563 print file2 "# This file was automatically generated by gosa-si-client. Do not change.\n";
564 print file1 "uri";
565 print file2 "uri";
566 foreach $element (@ldap_uris) {
567 print file1 " $element";
568 print file2 " $element";
569 }
570 print file1 "\nbase $ldap_base\n";
571 print file2 "\nbase $ldap_base\n";
572 foreach $element (@pam_options) {
573 print file1 "$element\n";
574 }
575 foreach $element (@nss_options) {
576 print file2 "$element\n";
577 }
578 close (file2);
579 daemon_log("wrote $nss_config", 5);
580 close (file1);
581 daemon_log("wrote $pam_config", 5);
583 # Create goto.secrets if told so - for compatibility reasons
584 if (defined $goto_admin){
585 open(file1, "> /etc/goto/secret");
586 close(file1);
587 chown(0,0, "/etc/goto/secret");
588 chmod(0600, "/etc/goto/secret");
589 open(file1, "> /etc/goto/secret");
590 print file1 "GOTOADMIN=\"$goto_admin\"\nGOTOSECRET=\"$goto_secret\"\n";
591 close(file1);
592 daemon_log("wrote /etc/goto/secret", 5);
593 }
597 # Write shell based config
598 my $cfg_name= dirname($ldap_config)."/ldap-shell.conf";
599 open(file1, "> $cfg_name");
600 print file1 "LDAP_BASE=\"$ldap_base\"\n";
601 print file1 "ADMIN_BASE=\"$admin_base\"\n";
602 print file1 "DEPARTMENT=\"$department\"\n";
603 print file1 "RELEASE=\"$release\"\n";
604 print file1 "UNIT_TAG=\"".(defined $unit_tag ? "$unit_tag" : "")."\"\n";
605 print file1 "UNIT_TAG_FILTER=\"".(defined $unit_tag ? "(gosaUnitTag=$unit_tag)" : "")."\"\n";
606 close(file1);
607 daemon_log("wrote $cfg_name", 5);
609 return;
611 }
614 sub generate_hw_digest {
615 my $hw_data;
616 foreach my $line (split /\n/, `cat /proc/bus/pci/devices`) {
617 $hw_data.= sprintf "%s", $line =~ /[^\s]+\s([^\s]+)\s.*/;
618 }
619 return(md5_base64($hw_data));
620 }
623 sub create_passwd {
624 my $new_passwd = "";
625 for(my $i=0; $i<31; $i++) {
626 $new_passwd .= ("a".."z","A".."Z",0..9)[int(rand(62))]
627 }
629 return $new_passwd;
630 }
633 sub get_server_addresses {
634 my $domain= shift;
635 my @result;
637 my $error = 0;
638 my $res = Net::DNS::Resolver->new;
639 my $query = $res->send("_gosad._tcp.".$domain, "SRV");
640 my @hits;
642 if ($query) {
643 foreach my $rr ($query->answer) {
644 push(@hits, $rr->target.":".$rr->port);
645 }
646 }
647 else {
648 #warn "query failed: ", $res->errorstring, "\n";
649 $error++;
650 }
652 if( $error == 0 ) {
653 foreach my $hit (@hits) {
654 my ($hit_name, $hit_port) = split(/:/, $hit);
656 my $address_query = $res->send($hit_name);
657 if( 1 == length($address_query->answer) ) {
658 foreach my $rr ($address_query->answer) {
659 push(@result, $rr->address.":".$hit_port);
660 }
661 }
662 }
663 }
665 # my $dig_cmd= 'dig +nocomments srv _gosad._tcp.'.$domain;
666 #
667 # my $output= `$dig_cmd 2>&1`;
668 # open (PIPE, "$dig_cmd 2>&1 |");
669 # while(<PIPE>) {
670 # chomp $_;
671 # # If it's not a comment
672 # if($_ =~ m/^[^;]/) {
673 # my @matches= split /\s+/;
674 #
675 # # Push hostname with port
676 # if($matches[3] eq 'SRV') {
677 # push @result, $matches[7].':'.$matches[6];
678 # } elsif ($matches[3] eq 'A') {
679 # my $i=0;
680 #
681 # # Substitute the hostname with the ip address of the matching A record
682 # foreach my $host (@result) {
683 # if ((split /\:/, $host)[0] eq $matches[0]) {
684 # $result[$i]= $matches[4].':'.(split /\:/, $host)[1];
685 # }
686 # $i++;
687 # }
688 # }
689 # }
690 # }
691 # close(PIPE);
692 return @result;
693 }
696 ##=== FUNCTION ================================================================
697 ## NAME: create_ciphering
698 ## PARAMETERS: passwd - string - used to create ciphering
699 ## RETURNS: cipher - object
700 ## DESCRIPTION: creates a Crypt::Rijndael::MODE_CBC object with passwd as key
701 ##===============================================================================
702 #sub create_ciphering {
703 # my ($passwd) = @_;
704 # $passwd = substr(md5_hex("$passwd") x 32, 0, 32);
705 # my $iv = substr(md5_hex('GONICUS GmbH'),0, 16);
706 #
707 # #daemon_log("iv: $iv", 7);
708 # #daemon_log("key: $passwd", 7);
709 # my $my_cipher = Crypt::Rijndael->new($passwd , Crypt::Rijndael::MODE_CBC());
710 # $my_cipher->set_iv($iv);
711 # return $my_cipher;
712 #}
713 #
714 #
715 #sub create_ciphering {
716 # my ($passwd) = @_;
717 # $passwd = substr(md5_hex("$passwd") x 32, 0, 32);
718 # my $iv = substr(md5_hex('GONICUS GmbH'),0, 16);
719 # my $my_cipher = Crypt::Rijndael->new($passwd , Crypt::Rijndael::MODE_CBC());
720 # $my_cipher->set_iv($iv);
721 # return $my_cipher;
722 #}
723 #
724 #
725 #sub encrypt_msg {
726 # my ($msg, $key) = @_;
727 # my $my_cipher = &create_ciphering($key);
728 # {
729 # use bytes;
730 # $msg = "\0"x(16-length($msg)%16).$msg;
731 # }
732 # $msg = $my_cipher->encrypt($msg);
733 # chomp($msg = &encode_base64($msg));
734 # # there are no newlines allowed inside msg
735 # $msg=~ s/\n//g;
736 # return $msg;
737 #}
738 #
739 #
740 #sub decrypt_msg {
741 # my ($msg, $key) = @_ ;
742 # $msg = &decode_base64($msg);
743 # my $my_cipher = &create_ciphering($key);
744 # $msg = $my_cipher->decrypt($msg);
745 # $msg =~ s/\0*//g;
746 # return $msg;
747 #}
750 #=== FUNCTION ================================================================
751 # NAME: send_msg_hash_to_target
752 # PARAMETERS: msg_hash - hash - xml_hash created with function create_xml_hash
753 # PeerAddr string - socket address to send msg
754 # PeerPort string - socket port, if not included in socket address
755 # RETURNS: nothing
756 # DESCRIPTION: ????
757 #===============================================================================
758 sub send_msg_hash_to_target {
759 my ($msg_hash, $address, $encrypt_key) = @_ ;
760 my $msg = &create_xml_string($msg_hash);
761 my $header = @{$msg_hash->{'header'}}[0];
762 my $error = &send_msg_to_target($msg, $address, $encrypt_key, $header);
764 return $error;
765 }
768 sub send_msg_to_target {
769 my ($msg, $address, $encrypt_key, $msg_header) = @_ ;
770 my $error = 0;
772 if( $msg_header ) {
773 $msg_header = "'$msg_header'-";
774 }
775 else {
776 $msg_header = "";
777 }
779 # encrypt xml msg
780 my $crypted_msg = &encrypt_msg($msg, $encrypt_key);
782 # opensocket
783 my $socket = &open_socket($address);
784 if( !$socket ) {
785 daemon_log("cannot send ".$msg_header."msg to $address , host not reachable", 1);
786 $error++;
787 }
789 if( $error == 0 ) {
790 # send xml msg
791 print $socket $crypted_msg."\n";
793 daemon_log("send ".$msg_header."msg to $address", 1);
794 daemon_log("message:\n$msg", 8);
796 }
798 # close socket in any case
799 if( $socket ) {
800 close $socket;
801 }
803 return $error;
804 }
807 sub write_to_file {
808 my ($string, $file) = @_;
809 my $error = 0;
811 if( not defined $file || not -f $file ) {
812 &main::daemon_log("ERROR: $prg: check '-f file' failed: $file", 1);
813 $error++;
814 }
815 if( not defined $string || 0 == length($string)) {
816 &main::daemon_log("ERROR: $prg: empty string to write to file '$file'", 1);
817 $error++;
818 }
820 if( $error == 0 ) {
822 chomp($string);
824 open(FILE, ">> $file");
825 print FILE $string."\n";
826 close(FILE);
827 }
829 return;
830 }
833 sub open_socket {
834 my ($PeerAddr, $PeerPort) = @_ ;
835 if(defined($PeerPort)){
836 $PeerAddr = $PeerAddr.":".$PeerPort;
837 }
838 my $socket;
839 $socket = new IO::Socket::INET(PeerAddr => $PeerAddr,
840 Porto => "tcp",
841 Type => SOCK_STREAM,
842 Timeout => 5,
843 );
844 if(not defined $socket) {
845 return;
846 }
847 &daemon_log("open_socket: $PeerAddr", 7);
848 return $socket;
849 }
852 #=== FUNCTION ================================================================
853 # NAME: register_at_server
854 # PARAMETERS:
855 # RETURNS:
856 # DESCRIPTION:
857 #===============================================================================
858 sub register_at_gosa_si_server {
859 my ($kernel) = $_[KERNEL];
860 my $try_to_register = 0;
862 if( not $REGISTERED ) {
863 # create new passwd and ciphering object for client-server communication
864 $server_key = &create_passwd();
866 my $events = join( ", ", keys %{$event_hash} );
867 while(1) {
869 if( $try_to_register >= @servers ) {
870 last;
871 }
873 # fetch first gosa-si-server from @servers
874 my $server = shift(@servers);
876 # append shifted gosa-si-server at the end of @servers, so looking for servers never stop if
877 # a registration never occured
878 push( @servers, $server );
880 # Check if our ip is resolvable - if not: don't try to register
881 my $ip= &get_local_ip_for_remote_ip(sprintf("%s", $server =~ /^([0-9\.]*?):.*$/));
882 my $resolver= Net::DNS::Resolver->new;
883 my $dnsresult= $resolver->search($ip);
884 my $dnsname="";
885 if(!defined($dnsresult)) {
886 &write_to_file("goto-error-dns:$ip", $fai_logpath);
887 exit(1);
888 } else {
889 $dnsname=$dnsresult->{answer}[0]->{ptrdname};
890 }
892 # create registration msg
893 my $local_ip = &get_local_ip_for_remote_ip(sprintf("%s", $server =~ /^([0-9\.]*?):.*$/));
894 my $local_mac = &get_local_mac_for_remote_ip(sprintf("%s", $server =~ /^([0-9\.]*?):.*$/));
895 my $register_hash = &create_xml_hash("here_i_am", $local_ip.":".$client_port, $server);
896 &add_content2xml_hash($register_hash, "new_passwd", $server_key);
897 &add_content2xml_hash($register_hash, "mac_address", $local_mac);
898 &add_content2xml_hash($register_hash, "events", $events);
899 &add_content2xml_hash($register_hash, "gotoHardwareChecksum", $gotoHardwareChecksum);
901 # send xml hash to server with general server passwd
902 my $res = &send_msg_hash_to_target($register_hash, $server, $default_server_key);
903 if($res == 0) {
904 # reset try_to_register
905 $try_to_register = 0;
907 # Set fixed client address
908 $client_ip= &get_local_ip_for_remote_ip(sprintf("%s", $server =~ /^([0-9\.]*?):.*$/));
909 $client_address= "$client_ip:$client_port";
911 # Write the MAC address to file
912 if(stat($opts_file)) {
913 unlink($opts_file);
914 }
915 my $opts_file_FH;
916 my $hostname= $dnsname;
917 $hostname =~ s/\..*$//;
918 open($opts_file_FH, ">$opts_file");
919 print $opts_file_FH "MAC=\"$local_mac\"\n";
920 print $opts_file_FH "IPADDRESS=\"$client_ip\"\n";
921 print $opts_file_FH "HOSTNAME=\"$hostname\"\n";
922 print $opts_file_FH "FQDN=\"$dnsname\"\n";
923 close($opts_file_FH);
924 last;
925 } else {
926 $try_to_register++;
927 # wait 1 sec until trying to register again
928 sleep(1);
929 next;
930 }
931 }
933 if( $try_to_register >= @servers ) {
934 &write_to_file("gosa-si-no-server-available", $fai_logpath);
935 $kernel->delay_set('register_at_gosa_si_server', $delay_set_time);
936 }
937 else {
938 daemon_log("waiting for msg 'register_at_gosa_si_server'",1);
939 $kernel->delay_set('register_at_gosa_si_server', $delay_set_time);
940 # clear old settings and set it again
941 $kernel->delay_set('trigger_new_key', $server_key_lifetime);
942 }
943 }
944 return;
945 }
948 sub check_key_and_xml_validity {
949 my ($crypted_msg, $module_key) = @_;
950 #print STDERR "crypted_msg:$crypted_msg\n";
951 #print STDERR "modul_key:$module_key\n";
953 my $msg;
954 my $msg_hash;
955 eval{
956 $msg = &decrypt_msg($crypted_msg, $module_key);
957 &main::daemon_log("decrypted_msg: \n$msg", 8);
959 $msg_hash = $xml->XMLin($msg, ForceArray=>1);
961 ##############
962 # check header
963 my $header_l = $msg_hash->{'header'};
964 if( 1 != @{$header_l} ) {
965 die 'no or more headers specified';
966 }
967 my $header = @{$header_l}[0];
968 if( 0 == length $header) {
969 die 'header has length 0';
970 }
972 ##############
973 # check source
974 my $source_l = $msg_hash->{'source'};
975 if( 1 != @{$source_l} ) {
976 die 'no or more than 1 sources specified';
977 }
978 my $source = @{$source_l}[0];
979 if( 0 == length $source) {
980 die 'source has length 0';
981 }
982 unless( $source =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d+$/ ) {
983 die "source '$source' is neither a complete ip-address with port nor 'GOSA'";
984 }
986 ##############
987 # check target
988 my $target_l = $msg_hash->{'target'};
989 if( 1 != @{$target_l} ) {
990 die 'no or more than 1 targets specified ';
991 }
992 my $target = @{$target_l}[0];
993 if( 0 == length $target) {
994 die 'target has length 0 ';
995 }
996 unless( $target =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d+$/ ){
997 die "source is neither a complete ip-address with port nor 'GOSA'";
998 }
999 };
1000 if($@) {
1001 &main::daemon_log("WARNING: do not understand the message or msg is not gosa-si envelope conform:", 5);
1002 &main::daemon_log("$@", 8);
1003 $msg = undef;
1004 $msg_hash = undef;
1005 }
1007 return ($msg, $msg_hash);
1008 }
1011 sub check_outgoing_xml_validity {
1012 my ($msg) = @_;
1014 my $msg_hash;
1015 eval{
1016 $msg_hash = $xml->XMLin($msg, ForceArray=>1);
1018 ##############
1019 # check header
1020 my $header_l = $msg_hash->{'header'};
1021 if( 1 != @{$header_l} ) {
1022 die 'no or more than one headers specified';
1023 }
1024 my $header = @{$header_l}[0];
1025 if( 0 == length $header) {
1026 die 'header has length 0';
1027 }
1029 ##############
1030 # check source
1031 my $source_l = $msg_hash->{'source'};
1032 if( 1 != @{$source_l} ) {
1033 die 'no or more than 1 sources specified';
1034 }
1035 my $source = @{$source_l}[0];
1036 if( 0 == length $source) {
1037 die 'source has length 0';
1038 }
1039 unless( $source =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d+$/ ||
1040 $source =~ /^GOSA$/i ) {
1041 die "source '$source' is neither a complete ip-address with port";
1042 }
1044 ##############
1045 # check target
1046 my $target_l = $msg_hash->{'target'};
1047 if( 1 != @{$target_l} ) {
1048 die "no or more than one targets specified";
1049 }
1050 foreach my $target (@$target_l) {
1051 if( 0 == length $target) {
1052 die "target has length 0";
1053 }
1054 unless( $target =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d+$/ ) {
1055 die "target '$target' is not a complete ip-address with port or a valid target name";
1056 }
1057 }
1058 };
1059 if($@) {
1060 daemon_log("WARNING: outgoing msg is not gosa-si envelope conform", 5);
1061 daemon_log("$@ $msg", 8);
1062 $msg_hash = undef;
1063 }
1064 return ($msg_hash);
1065 }
1068 sub import_events {
1070 if (not -e $event_dir) {
1071 daemon_log("ERROR: cannot find directory or directory is not readable: $event_dir", 1);
1072 }
1073 opendir (DIR, $event_dir) or die "ERROR while loading gosa-si-events from directory $event_dir : $!\n";
1075 while (defined (my $event = readdir (DIR))) {
1076 if( $event eq "." || $event eq ".." ) { next; }
1078 eval{ require $event; };
1079 if( $@ ) {
1080 daemon_log("ERROR: import of event module '$event' failed", 1);
1081 daemon_log("$@", 8);
1082 next;
1083 }
1085 $event =~ /(\S*?).pm$/;
1086 my $event_module = $1;
1087 my $events_l = eval( $1."::get_events()") ;
1088 foreach my $event_name (@{$events_l}) {
1089 $event_hash->{$event_name} = $event_module;
1090 }
1092 }
1093 }
1095 sub trigger_new_key {
1096 my ($kernel) = $_[KERNEL] ;
1098 my $msg = "<xml><header>new_key</header><source>$client_address</source><target>$client_address</target></xml>";
1099 &send_msg_to_target($msg, $client_address, $server_key, 'new_key');
1101 $kernel->delay_set('trigger_new_key', $server_key_lifetime);
1103 }
1106 sub _start {
1107 my ($kernel) = $_[KERNEL];
1108 $kernel->alias_set('client_session');
1109 $kernel->yield('register_at_gosa_si_server');
1110 }
1113 sub server_input {
1114 my ($kernel, $heap, $input, $wheel) = @_[KERNEL, HEAP, ARG0, ARG1];
1115 my $error = 0;
1116 my $answer;
1118 daemon_log("Incoming msg:\n$input\n", 8);
1120 my ($msg, $msg_hash) = &check_key_and_xml_validity($input, $server_key);
1121 if( (!$msg) || (!$msg_hash) ) {
1122 daemon_log("Deciphering of incoming msg failed", 5);
1123 $error++;
1124 }
1127 ######################
1128 # process incoming msg
1129 if( $error == 0 ) {
1130 my $header = @{$msg_hash->{header}}[0];
1131 my $source = @{$msg_hash->{source}}[0];
1133 if( exists $event_hash->{$header} ) {
1134 # a event exists with the header as name
1135 daemon_log("found event '$header' at event-module '".$event_hash->{$header}."'", 5);
1136 no strict 'refs';
1137 $answer = &{$event_hash->{$header}."::$header"}($msg, $msg_hash);
1138 }
1139 else {
1140 daemon_log("WARNING: no event '$header' found in event modules under $event_dir", 1);
1141 }
1142 }
1144 ########
1145 # answer
1146 if( $answer ) {
1148 #check gosa-si envelope validity
1149 my $answer_hash = &check_outgoing_xml_validity($answer);
1151 if( $answer_hash ) {
1152 # answer is valid
1154 # preprocessing
1155 if( $answer =~ "<header>registered</header>") {
1156 # set registered flag to true to stop sending further registered msgs
1157 $REGISTERED = 1;
1158 }
1159 else {
1160 &send_msg_to_target($answer, $server_address, $server_key);
1161 }
1163 # postprocessing
1164 if( $answer =~ "<header>new_key</header>") {
1165 # set new key to global variable
1166 $answer =~ /<new_key>(\S*?)<\/new_key>/;
1167 my $new_key = $1;
1168 $server_key = $new_key;
1169 }
1170 }
1172 }
1174 return;
1175 }
1177 #==== MAIN = main ==============================================================
1178 # parse commandline options
1179 Getopt::Long::Configure( "bundling" );
1180 GetOptions("h|help" => \&usage,
1181 "c|config=s" => \$cfg_file,
1182 "f|foreground" => \$foreground,
1183 "v|verbose+" => \$verbose,
1184 );
1186 # read and set config parameters
1187 &check_cmdline_param ;
1188 &read_configfile($cfg_file, %cfg_defaults);
1189 &check_pid;
1192 # forward error messages to logfile
1193 if ( ! $foreground ) {
1194 open STDIN, '/dev/null' or die "Can’t read /dev/null: $!";
1195 open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!";
1196 open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!";
1197 }
1199 # Just fork, if we are not in foreground mode
1200 if( ! $foreground ) {
1201 chdir '/' or die "Can't chdir to /: $!";
1202 $pid = fork;
1203 setsid or die "Can't start a new session: $!";
1204 umask 0;
1205 }
1206 else {
1207 $pid = $$;
1208 }
1210 # Do something useful - put our PID into the pid_file
1211 if( 0 != $pid ) {
1212 open( LOCK_FILE, ">$pid_file" );
1213 print LOCK_FILE "$pid\n";
1214 close( LOCK_FILE );
1215 if( !$foreground ) {
1216 exit( 0 )
1217 };
1218 }
1220 daemon_log(" ", 1);
1221 daemon_log("$prg started!", 1);
1223 # delete old DBsqlite lock files
1224 system('rm -f /tmp/gosa_si_lock*gosa-si-client*');
1226 # detect ip and mac address and complete host address
1227 $client_address = $client_ip.":".$client_port;
1228 my $network_interface= &get_interface_for_ip($client_ip);
1229 $client_mac_address= &get_mac($network_interface);
1230 daemon_log("gosa-si-client ip address detected: $client_ip", 1);
1231 daemon_log("gosa-si-client mac address detected: $client_mac_address", 1);
1234 # import events
1235 &import_events();
1238 # compute hardware checksum
1239 $gotoHardwareChecksum= &generate_hw_digest();
1240 daemon_log("gosa-si-client gotoHardwareChecksum detected: $gotoHardwareChecksum", 1);
1243 # create socket for incoming xml messages
1244 POE::Component::Server::TCP->new(
1245 Alias => 'gosa-si-client',
1246 Port => $client_port,
1247 ClientInput => \&server_input,
1248 );
1249 daemon_log("start socket for incoming xml messages at port '$client_port' ", 1);
1252 # prepare variables
1253 if (defined $server_ip && defined $server_port) {
1254 $server_address = $server_ip.":".$server_port;
1255 }
1256 $xml = new XML::Simple();
1257 $default_server_key = $server_key;
1260 # add gosa-si-server address from config file at first position of server list
1261 if (defined $server_address) {
1262 unshift(@servers, $server_address);
1263 my $servers_string = join(", ", @servers);
1264 daemon_log("found servers in configuration file: $servers_string", 5);
1265 }
1266 else {
1267 if ( !$server_domain) {
1268 daemon_log("ERROR: please specify a gosa-si-server address or a domain in config file", 1);
1269 exit( 1 );
1270 }
1271 my @tmp_servers = &get_server_addresses($server_domain);
1272 foreach my $server (@tmp_servers) {
1273 unshift(@servers, $server);
1274 }
1275 my $servers_string = join(", ", @servers);
1276 daemon_log("found servers in DNS: $servers_string", 5);
1277 }
1282 POE::Session->create(
1283 inline_states => {
1284 _start => \&_start,
1285 register_at_gosa_si_server => \®ister_at_gosa_si_server,
1286 trigger_new_key => \&trigger_new_key,
1287 }
1288 );
1290 POE::Kernel->run();
1291 exit;