| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package FusionInventory::Agent::Config; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 22 |  |  | 22 |  | 2740339 | use strict; | 
|  | 22 |  |  |  |  | 40 |  | 
|  | 22 |  |  |  |  | 861 |  | 
| 4 | 22 |  |  | 22 |  | 106 | use warnings; | 
|  | 22 |  |  |  |  | 31 |  | 
|  | 22 |  |  |  |  | 714 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 22 |  |  | 22 |  | 571 | use English qw(-no_match_vars); | 
|  | 22 |  |  |  |  | 3196 |  | 
|  | 22 |  |  |  |  | 245 |  | 
| 7 | 22 |  |  | 22 |  | 8566 | use File::Spec; | 
|  | 22 |  |  |  |  | 33 |  | 
|  | 22 |  |  |  |  | 328 |  | 
| 8 | 22 |  |  | 22 |  | 17866 | use Getopt::Long; | 
|  | 22 |  |  |  |  | 241625 |  | 
|  | 22 |  |  |  |  | 137 |  | 
| 9 | 22 |  |  | 22 |  | 4316 | use UNIVERSAL::require; | 
|  | 22 |  |  |  |  | 1143 |  | 
|  | 22 |  |  |  |  | 206 |  | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | my $default = { | 
| 12 |  |  |  |  |  |  | 'additional-content'      => undef, | 
| 13 |  |  |  |  |  |  | 'backend-collect-timeout' => 180, | 
| 14 |  |  |  |  |  |  | 'ca-cert-dir'             => undef, | 
| 15 |  |  |  |  |  |  | 'ca-cert-file'            => undef, | 
| 16 |  |  |  |  |  |  | 'color'                   => undef, | 
| 17 |  |  |  |  |  |  | 'debug'                   => undef, | 
| 18 |  |  |  |  |  |  | 'delaytime'               => 3600, | 
| 19 |  |  |  |  |  |  | 'force'                   => undef, | 
| 20 |  |  |  |  |  |  | 'html'                    => undef, | 
| 21 |  |  |  |  |  |  | 'lazy'                    => undef, | 
| 22 |  |  |  |  |  |  | 'local'                   => undef, | 
| 23 |  |  |  |  |  |  | 'logger'                  => 'Stderr', | 
| 24 |  |  |  |  |  |  | 'logfile'                 => undef, | 
| 25 |  |  |  |  |  |  | 'logfacility'             => 'LOG_USER', | 
| 26 |  |  |  |  |  |  | 'logfile-maxsize'         => undef, | 
| 27 |  |  |  |  |  |  | 'no-category'             => [], | 
| 28 |  |  |  |  |  |  | 'no-httpd'                => undef, | 
| 29 |  |  |  |  |  |  | 'no-ssl-check'            => undef, | 
| 30 |  |  |  |  |  |  | 'no-task'                 => [], | 
| 31 |  |  |  |  |  |  | 'no-p2p'                  => undef, | 
| 32 |  |  |  |  |  |  | 'password'                => undef, | 
| 33 |  |  |  |  |  |  | 'proxy'                   => undef, | 
| 34 |  |  |  |  |  |  | 'httpd-ip'                => undef, | 
| 35 |  |  |  |  |  |  | 'httpd-port'              => 62354, | 
| 36 |  |  |  |  |  |  | 'httpd-trust'             => [], | 
| 37 |  |  |  |  |  |  | 'scan-homedirs'           => undef, | 
| 38 |  |  |  |  |  |  | 'scan-profiles'           => undef, | 
| 39 |  |  |  |  |  |  | 'server'                  => undef, | 
| 40 |  |  |  |  |  |  | 'tag'                     => undef, | 
| 41 |  |  |  |  |  |  | 'timeout'                 => 180, | 
| 42 |  |  |  |  |  |  | 'user'                    => undef, | 
| 43 |  |  |  |  |  |  | # deprecated options | 
| 44 |  |  |  |  |  |  | 'stdout'                  => undef, | 
| 45 |  |  |  |  |  |  | # multi-values options that will be converted to array ref | 
| 46 |  |  |  |  |  |  | 'httpd-trust'             => "", | 
| 47 |  |  |  |  |  |  | 'no-task'                 => "", | 
| 48 |  |  |  |  |  |  | 'no-category'             => "" | 
| 49 |  |  |  |  |  |  | }; | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | my $deprecated = { | 
| 52 |  |  |  |  |  |  | 'stdout' => { | 
| 53 |  |  |  |  |  |  | message => 'use --local - option instead', | 
| 54 |  |  |  |  |  |  | new     => { 'local' => '-' } | 
| 55 |  |  |  |  |  |  | }, | 
| 56 |  |  |  |  |  |  | }; | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | sub new { | 
| 59 | 3 |  |  | 3 | 1 | 15198 | my ($class, %params) = @_; | 
| 60 |  |  |  |  |  |  |  | 
| 61 | 3 |  |  |  |  | 7 | my $self = {}; | 
| 62 | 3 |  |  |  |  | 6 | bless $self, $class; | 
| 63 | 3 |  |  |  |  | 10 | $self->_loadDefaults(); | 
| 64 | 3 | 0 |  |  |  | 24 | my $backend = | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | $params{options}->{'conf-file'} ? 'file'                     : | 
| 66 |  |  |  |  |  |  | $params{options}->{config}      ? $params{options}->{config} : | 
| 67 |  |  |  |  |  |  | $OSNAME eq 'MSWin32'            ? 'registry'                 : | 
| 68 |  |  |  |  |  |  | 'file'; | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | SWITCH: { | 
| 71 | 3 | 50 |  |  |  | 3 | if ($backend eq 'registry') { | 
|  | 3 |  |  |  |  | 8 |  | 
| 72 | 0 | 0 |  |  |  | 0 | die "Unavailable configuration backend\n" | 
| 73 |  |  |  |  |  |  | unless $OSNAME eq 'MSWin32'; | 
| 74 | 0 |  |  |  |  | 0 | $self->_loadFromRegistry(); | 
| 75 | 0 |  |  |  |  | 0 | last SWITCH; | 
| 76 |  |  |  |  |  |  | } | 
| 77 |  |  |  |  |  |  |  | 
| 78 | 3 | 50 |  |  |  | 9 | if ($backend eq 'file') { | 
| 79 | 3 |  |  |  |  | 15 | $self->_loadFromFile({ | 
| 80 |  |  |  |  |  |  | file      => $params{options}->{'conf-file'}, | 
| 81 |  |  |  |  |  |  | directory => $params{confdir}, | 
| 82 |  |  |  |  |  |  | }); | 
| 83 | 3 |  |  |  |  | 11 | last SWITCH; | 
| 84 |  |  |  |  |  |  | } | 
| 85 |  |  |  |  |  |  |  | 
| 86 | 0 | 0 |  |  |  | 0 | if ($backend eq 'none') { | 
| 87 | 0 |  |  |  |  | 0 | last SWITCH; | 
| 88 |  |  |  |  |  |  | } | 
| 89 |  |  |  |  |  |  |  | 
| 90 | 0 |  |  |  |  | 0 | die "Unknown configuration backend '$backend'\n"; | 
| 91 |  |  |  |  |  |  | } | 
| 92 |  |  |  |  |  |  |  | 
| 93 | 3 |  |  |  |  | 12 | $self->_loadUserParams($params{options}); | 
| 94 |  |  |  |  |  |  |  | 
| 95 | 3 |  |  |  |  | 10 | $self->_checkContent(); | 
| 96 |  |  |  |  |  |  |  | 
| 97 | 3 |  |  |  |  | 11 | return $self; | 
| 98 |  |  |  |  |  |  | } | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | sub _loadDefaults { | 
| 101 | 3 |  |  | 3 |  | 4 | my ($self) = @_; | 
| 102 |  |  |  |  |  |  |  | 
| 103 | 3 |  |  |  |  | 26 | foreach my $key (keys %$default) { | 
| 104 | 96 |  |  |  |  | 116 | $self->{$key} = $default->{$key}; | 
| 105 |  |  |  |  |  |  | } | 
| 106 |  |  |  |  |  |  | } | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  | sub _loadFromRegistry { | 
| 109 | 0 |  |  | 0 |  | 0 | my ($self) = @_; | 
| 110 |  |  |  |  |  |  |  | 
| 111 | 0 |  |  |  |  | 0 | my $Registry; | 
| 112 | 0 |  |  |  |  | 0 | Win32::TieRegistry->require(); | 
| 113 | 0 |  |  |  |  | 0 | Win32::TieRegistry->import( | 
| 114 |  |  |  |  |  |  | Delimiter   => '/', | 
| 115 |  |  |  |  |  |  | ArrayValues => 0, | 
| 116 |  |  |  |  |  |  | TiedRef     => \$Registry | 
| 117 |  |  |  |  |  |  | ); | 
| 118 |  |  |  |  |  |  |  | 
| 119 | 0 | 0 |  |  |  | 0 | my $machKey = $Registry->Open('LMachine', { | 
| 120 |  |  |  |  |  |  | Access => Win32::TieRegistry::KEY_READ() | 
| 121 |  |  |  |  |  |  | }) or die "Can't open HKEY_LOCAL_MACHINE key: $EXTENDED_OS_ERROR"; | 
| 122 |  |  |  |  |  |  |  | 
| 123 | 0 |  |  |  |  | 0 | my $settings = $machKey->{"SOFTWARE/FusionInventory-Agent"}; | 
| 124 |  |  |  |  |  |  |  | 
| 125 | 0 |  |  |  |  | 0 | foreach my $rawKey (keys %$settings) { | 
| 126 | 0 | 0 |  |  |  | 0 | next unless $rawKey =~ /^\/(\S+)/; | 
| 127 | 0 |  |  |  |  | 0 | my $key = lc($1); | 
| 128 | 0 |  |  |  |  | 0 | my $val = $settings->{$rawKey}; | 
| 129 |  |  |  |  |  |  | # Remove the quotes | 
| 130 | 0 |  |  |  |  | 0 | $val =~ s/\s+$//; | 
| 131 | 0 |  |  |  |  | 0 | $val =~ s/^'(.*)'$/$1/; | 
| 132 | 0 |  |  |  |  | 0 | $val =~ s/^"(.*)"$/$1/; | 
| 133 |  |  |  |  |  |  |  | 
| 134 | 0 | 0 |  |  |  | 0 | if (exists $default->{$key}) { | 
| 135 | 0 |  |  |  |  | 0 | $self->{$key} = $val; | 
| 136 |  |  |  |  |  |  | } else { | 
| 137 | 0 |  |  |  |  | 0 | warn "unknown configuration directive $key"; | 
| 138 |  |  |  |  |  |  | } | 
| 139 |  |  |  |  |  |  | } | 
| 140 |  |  |  |  |  |  | } | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | sub _loadFromFile { | 
| 143 | 3 |  |  | 3 |  | 4 | my ($self, $params) = @_; | 
| 144 | 3 | 50 |  |  |  | 8 | my $file = $params->{file} ? | 
| 145 |  |  |  |  |  |  | $params->{file} : $params->{directory} . '/agent.cfg'; | 
| 146 |  |  |  |  |  |  |  | 
| 147 | 3 | 50 |  |  |  | 7 | if ($file) { | 
| 148 | 3 | 50 |  |  |  | 70 | die "non-existing file $file" unless -f $file; | 
| 149 | 3 | 50 |  |  |  | 29 | die "non-readable file $file" unless -r $file; | 
| 150 |  |  |  |  |  |  | } else { | 
| 151 | 0 |  |  |  |  | 0 | die "no configuration file"; | 
| 152 |  |  |  |  |  |  | } | 
| 153 |  |  |  |  |  |  |  | 
| 154 | 3 |  |  |  |  | 4 | my $handle; | 
| 155 | 3 | 50 |  |  |  | 97 | if (!open $handle, '<', $file) { | 
| 156 | 0 |  |  |  |  | 0 | warn "Config: Failed to open $file: $ERRNO"; | 
| 157 | 0 |  |  |  |  | 0 | return; | 
| 158 |  |  |  |  |  |  | } | 
| 159 |  |  |  |  |  |  |  | 
| 160 | 3 |  |  |  |  | 49 | while (my $line = <$handle>) { | 
| 161 | 8 |  |  |  |  | 32 | $line =~ s/#.+//; | 
| 162 | 8 | 100 |  |  |  | 44 | if ($line =~ /([\w-]+)\s*=\s*(.+)/) { | 
| 163 | 3 |  |  |  |  | 9 | my $key = $1; | 
| 164 | 3 |  |  |  |  | 8 | my $val = $2; | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | # Remove the quotes | 
| 167 | 3 |  |  |  |  | 7 | $val =~ s/\s+$//; | 
| 168 | 3 |  |  |  |  | 5 | $val =~ s/^'(.*)'$/$1/; | 
| 169 | 3 |  |  |  |  | 4 | $val =~ s/^"(.*)"$/$1/; | 
| 170 |  |  |  |  |  |  |  | 
| 171 | 3 | 50 |  |  |  | 7 | if (exists $default->{$key}) { | 
| 172 | 3 |  |  |  |  | 13 | $self->{$key} = $val; | 
| 173 |  |  |  |  |  |  | } else { | 
| 174 | 0 |  |  |  |  | 0 | warn "unknown configuration directive $key"; | 
| 175 |  |  |  |  |  |  | } | 
| 176 |  |  |  |  |  |  | } | 
| 177 |  |  |  |  |  |  | } | 
| 178 | 3 |  |  |  |  | 31 | close $handle; | 
| 179 |  |  |  |  |  |  | } | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | sub _loadUserParams { | 
| 182 | 3 |  |  | 3 |  | 5 | my ($self, $params) = @_; | 
| 183 |  |  |  |  |  |  |  | 
| 184 | 3 |  |  |  |  | 14 | foreach my $key (keys %$params) { | 
| 185 | 3 |  |  |  |  | 12 | $self->{$key} = $params->{$key}; | 
| 186 |  |  |  |  |  |  | } | 
| 187 |  |  |  |  |  |  | } | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | sub _checkContent { | 
| 190 | 3 |  |  | 3 |  | 7 | my ($self) = @_; | 
| 191 |  |  |  |  |  |  |  | 
| 192 |  |  |  |  |  |  | # check for deprecated options | 
| 193 | 3 |  |  |  |  | 8 | foreach my $old (keys %$deprecated) { | 
| 194 | 3 | 50 |  |  |  | 13 | next unless defined $self->{$old}; | 
| 195 |  |  |  |  |  |  |  | 
| 196 | 0 | 0 | 0 |  |  | 0 | next if $old =~ /^no-/ and !$self->{$old}; | 
| 197 |  |  |  |  |  |  |  | 
| 198 | 0 |  |  |  |  | 0 | my $handler = $deprecated->{$old}; | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | # notify user of deprecation | 
| 201 | 0 |  |  |  |  | 0 | warn "the '$old' option is deprecated, $handler->{message}\n"; | 
| 202 |  |  |  |  |  |  |  | 
| 203 |  |  |  |  |  |  | # transfer the value to the new option, if possible | 
| 204 | 0 | 0 |  |  |  | 0 | if ($handler->{new}) { | 
| 205 | 0 | 0 |  |  |  | 0 | if (ref $handler->{new} eq 'HASH') { | 
|  |  | 0 |  |  |  |  |  | 
| 206 |  |  |  |  |  |  | # old boolean option replaced by new non-boolean options | 
| 207 | 0 |  |  |  |  | 0 | foreach my $key (keys %{$handler->{new}}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 208 | 0 |  |  |  |  | 0 | my $value = $handler->{new}->{$key}; | 
| 209 | 0 | 0 |  |  |  | 0 | if ($value =~ /^\+(\S+)/) { | 
| 210 |  |  |  |  |  |  | # multiple values: add it to exiting one | 
| 211 | 0 | 0 |  |  |  | 0 | $self->{$key} = $self->{$key} ? | 
| 212 |  |  |  |  |  |  | $self->{$key} . ',' . $1 : $1; | 
| 213 |  |  |  |  |  |  | } else { | 
| 214 |  |  |  |  |  |  | # unique value: replace exiting value | 
| 215 | 0 |  |  |  |  | 0 | $self->{$key} = $value; | 
| 216 |  |  |  |  |  |  | } | 
| 217 |  |  |  |  |  |  | } | 
| 218 |  |  |  |  |  |  | } elsif (ref $handler->{new} eq 'ARRAY') { | 
| 219 |  |  |  |  |  |  | # old boolean option replaced by new boolean options | 
| 220 | 0 |  |  |  |  | 0 | foreach my $new (@{$handler->{new}}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 221 | 0 |  |  |  |  | 0 | $self->{$new} = $self->{$old}; | 
| 222 |  |  |  |  |  |  | } | 
| 223 |  |  |  |  |  |  | } else { | 
| 224 |  |  |  |  |  |  | # old non-boolean option replaced by new option | 
| 225 | 0 |  |  |  |  | 0 | $self->{$handler->{new}} = $self->{$old}; | 
| 226 |  |  |  |  |  |  | } | 
| 227 |  |  |  |  |  |  | } | 
| 228 |  |  |  |  |  |  |  | 
| 229 |  |  |  |  |  |  | # avoid cluttering configuration | 
| 230 | 0 |  |  |  |  | 0 | delete $self->{$old}; | 
| 231 |  |  |  |  |  |  | } | 
| 232 |  |  |  |  |  |  |  | 
| 233 |  |  |  |  |  |  | # a logfile options implies a file logger backend | 
| 234 | 3 | 50 |  |  |  | 10 | if ($self->{logfile}) { | 
| 235 | 0 |  |  |  |  | 0 | $self->{logger} .= ',File'; | 
| 236 |  |  |  |  |  |  | } | 
| 237 |  |  |  |  |  |  |  | 
| 238 |  |  |  |  |  |  | # ca-cert-file and ca-cert-dir are antagonists | 
| 239 | 3 | 50 | 33 |  |  | 11 | if ($self->{'ca-cert-file'} && $self->{'ca-cert-dir'}) { | 
| 240 | 0 |  |  |  |  | 0 | die "use either 'ca-cert-file' or 'ca-cert-dir' option, not both\n"; | 
| 241 |  |  |  |  |  |  | } | 
| 242 |  |  |  |  |  |  |  | 
| 243 |  |  |  |  |  |  | # logger backend without a logfile isn't enoguh | 
| 244 | 3 | 50 | 33 |  |  | 15 | if ($self->{'logger'} =~ /file/i && ! $self->{'logfile'}) { | 
| 245 | 0 |  |  |  |  | 0 | die "usage of 'file' logger backend makes 'logfile' option mandatory\n"; | 
| 246 |  |  |  |  |  |  | } | 
| 247 |  |  |  |  |  |  |  | 
| 248 |  |  |  |  |  |  | # multi-values options, the default separator is a ',' | 
| 249 | 3 |  |  |  |  | 6 | foreach my $option (qw/ | 
| 250 |  |  |  |  |  |  | logger | 
| 251 |  |  |  |  |  |  | local | 
| 252 |  |  |  |  |  |  | server | 
| 253 |  |  |  |  |  |  | httpd-trust | 
| 254 |  |  |  |  |  |  | no-task | 
| 255 |  |  |  |  |  |  | no-category | 
| 256 |  |  |  |  |  |  | /) { | 
| 257 |  |  |  |  |  |  |  | 
| 258 | 18 | 100 |  |  |  | 32 | if ($self->{$option}) { | 
| 259 | 6 |  |  |  |  | 21 | $self->{$option} = [split(/,/, $self->{$option})]; | 
| 260 |  |  |  |  |  |  | } else { | 
| 261 | 12 |  |  |  |  | 37 | $self->{$option} = []; | 
| 262 |  |  |  |  |  |  | } | 
| 263 |  |  |  |  |  |  | } | 
| 264 |  |  |  |  |  |  |  | 
| 265 |  |  |  |  |  |  | # files location | 
| 266 | 3 | 50 |  |  |  | 10 | $self->{'ca-cert-file'} = | 
| 267 |  |  |  |  |  |  | File::Spec->rel2abs($self->{'ca-cert-file'}) if $self->{'ca-cert-file'}; | 
| 268 | 3 | 50 |  |  |  | 6 | $self->{'ca-cert-dir'} = | 
| 269 |  |  |  |  |  |  | File::Spec->rel2abs($self->{'ca-cert-dir'}) if $self->{'ca-cert-dir'}; | 
| 270 | 3 | 50 |  |  |  | 9 | $self->{'logfile'} = | 
| 271 |  |  |  |  |  |  | File::Spec->rel2abs($self->{'logfile'}) if $self->{'logfile'}; | 
| 272 |  |  |  |  |  |  | } | 
| 273 |  |  |  |  |  |  |  | 
| 274 |  |  |  |  |  |  | 1; | 
| 275 |  |  |  |  |  |  | __END__ |