File Coverage

blib/lib/Doit/Deb.pm
Criterion Covered Total %
statement 37 96 38.5
branch 8 54 14.8
condition 1 3 33.3
subroutine 7 9 77.7
pod 3 5 60.0
total 56 167 33.5


line stmt bran cond sub pod time code
1             # -*- perl -*-
2              
3             #
4             # Author: Slaven Rezic
5             #
6             # Copyright (C) 2017,2018,2020 Slaven Rezic. All rights reserved.
7             # This package is free software; you can redistribute it and/or
8             # modify it under the same terms as Perl itself.
9             #
10             # Mail: slaven@rezic.de
11             # WWW: http://www.rezic.de/eserte/
12             #
13              
14             package Doit::Deb; # Convention: all commands here should be prefixed with 'deb_'
15              
16 2     2   14 use strict;
  2         3  
  2         85  
17 2     2   27 use warnings;
  2         4  
  2         102  
18             our $VERSION = '0.024';
19              
20 2     2   10 use Doit::Log;
  2         3  
  2         124  
21 2     2   11 use Doit::Util 'get_sudo_cmd';
  2         4  
  2         1985  
22              
23 2     2 0 22 sub new { bless {}, shift }
24 2     2 0 8 sub functions { qw(deb_install_packages deb_missing_packages deb_install_key) }
25              
26             sub deb_install_packages {
27 0     0 1 0 my($self, @packages) = @_;
28 0         0 my @missing_packages = $self->deb_missing_packages(@packages); # XXX cmd vs. info???
29 0 0       0 if (@missing_packages) {
30 0         0 $self->system(get_sudo_cmd(), 'apt-get', '-y', 'install', @missing_packages);
31             }
32 0         0 @missing_packages;
33             }
34              
35              
36             sub deb_missing_packages {
37 2     2 1 6 my($self, @packages) = @_;
38              
39 2         5 my @missing_packages;
40              
41 2 50       7 if (@packages) {
42 2         425 require IPC::Open3;
43 2         2313 require Symbol;
44              
45 2         6 my %seen_packages;
46             my %required_version;
47 2         5 for my $package (@packages) {
48 2 50       9 if (ref $package eq 'ARRAY') {
49 0         0 my($package_name, $package_version) = @$package;
50 0         0 $required_version{$package_name} = $package_version;
51 0         0 $package = $package_name;
52             }
53             }
54 2         5 my @cmd = ('dpkg-query', '-W', '-f=${Package}\t${Status}\t${Version}\n', @packages);
55 2         16 my $err = Symbol::gensym();
56 2         56 my $fh;
57 2 50       7 my $pid = IPC::Open3::open3(undef, $fh, $err, @cmd)
58             or error "Error running '@cmd': $!";
59 2         39134 while(<$fh>) {
60 1         14 chomp;
61 1 50       25 if (m{^([^\t]+)\t([^\t]+)\t([^\t]*)$}) {
62 1 50       25 if ($2 ne 'install ok installed') {
63 0         0 push @missing_packages, $1;
64             }
65 1 50 33     19 if ($required_version{$1} && $required_version{$1} ne $3) {
66 0         0 push @missing_packages, $1;
67             }
68 1         21 $seen_packages{$1} = 1;
69             } else {
70 0         0 warning "cannot parse '$_', ignore line...";
71             }
72             }
73 2         48 waitpid $pid, 0;
74 2         27 for my $package (@packages) {
75 2 100       76 if (!$seen_packages{$package}) {
76 1         109 push @missing_packages, $package;
77             }
78             }
79             }
80 2         53 @missing_packages;
81             }
82              
83             sub deb_install_key {
84 0     0 1   my($self, %opts) = @_;
85 0           my $url = delete $opts{url};
86 0           my $keyserver = delete $opts{keyserver};
87 0           my $key = delete $opts{key};
88 0 0         error "Unhandled options: " . join(" ", %opts) if %opts;
89              
90 0 0         if (!$url) {
91 0 0         if (!$keyserver) {
92 0           error "keyserver is missing";
93             }
94 0 0         if (!$key) {
95 0           error "key is missing";
96             }
97             } else {
98 0 0         if ($keyserver) {
99 0           error "Don't define both url and keyserver";
100             }
101             }
102              
103 0           my $found_key;
104 0 0         if ($key) {
105 0           $key =~ s{\s}{}g; # convenience: strip spaces from key ('apt-key finger' returns them with spaces)
106 0           local $ENV{LC_ALL} = 'C';
107             # XXX If run with $sudo, then this will emit warnings in the form
108             # gpg: WARNING: unsafe ownership on configuration file `$HOME/.gnupg/gpg.conf'
109             # Annoying, but harmless. Could be workarounded by specifying
110             # '--homedir=/root/.gpg', but this would create gpg files under ~root. Similar
111             # if using something like
112             # local $ENV{HOME} = (getpwuid($<))[7];
113             # Probably better would be to work with privilege escalation and run
114             # this command as normal user (to be implemented).
115             #
116             # Older Debian (jessie and older?) have only /etc/apt/trusted.gpg,
117             # newer ones (stretch and newer?) have /etc/apt/trusted.gpg.d/*.gpg
118             SEARCH_FOR_KEY: {
119 0           require File::Glob;
  0            
120 0           for my $keyfile ('/etc/apt/trusted.gpg', File::Glob::bsd_glob('/etc/apt/trusted.gpg.d/*.gpg')) {
121 0 0         if (-r $keyfile) {
122 0           my @cmd = ('gpg', '--keyring', $keyfile, '--list-keys', '--fingerprint', '--with-colons');
123 0 0         open my $fh, '-|', @cmd
124             or error "Running '@cmd' failed: $!";
125 0           while(<$fh>) {
126 0 0         if (m{^fpr:::::::::\Q$key\E:$}) {
127 0           $found_key = 1;
128 0           last SEARCH_FOR_KEY;
129             }
130             }
131 0 0         close $fh
132             or error "Running '@cmd' failed: $!";
133             }
134             }
135             }
136             }
137              
138 0           my $changed = 0;
139 0 0         if (!$found_key) {
140 0 0         if ($keyserver) {
    0          
141 0           $self->system(get_sudo_cmd(), 'apt-key', 'adv', '--keyserver', $keyserver, '--recv-keys', $key);
142             } elsif ($url) {
143 0           my @fetch_cmd;
144 0 0         if ($self->which('curl')) {
145 0           @fetch_cmd = ('curl', '-fsSL', $url);
146             } else {
147 0           @fetch_cmd = ('wget', '-O-', $url); # other alternative would be lwp-request
148             }
149 0           my @add_cmd = (get_sudo_cmd(), 'apt-key', 'add', '-');
150 0 0         if ($self->is_dry_run) {
151 0           info "Fetch key using '@fetch_cmd' and add using '@add_cmd' (dry-run)";
152             } else {
153 0 0         open my $ifh, '-|', @fetch_cmd
154             or error "Failed to start '@fetch_cmd': $!";
155 0 0         open my $ofh, '|-', @add_cmd
156             or error "Failed to start '@add_cmd': $!";
157 0           local $/ = \1024;
158 0           while(<$ifh>) {
159 0           print $ofh $_;
160             }
161 0 0         close $ofh
162             or error "Running '@add_cmd' failed: $!";
163 0 0         close $ifh
164             or error "Running '@fetch_cmd' failed: $!";
165             }
166             } else {
167 0           error "Shouldn't happen (either url or keyserver has to be specified)";
168             }
169 0           $changed = 1;
170             }
171 0           $changed;
172             }
173              
174              
175             1;
176              
177             __END__