# duck # Copyright (C) 2016 Simon Kainz # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # he Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # On Debian GNU/Linux systems, the complete text of the GNU General # Public License can be found in `/usr/share/common-licenses/GPL-2'. # # You should have received a copy of the GNU General Public License # along with this program. If not, you can find it on the World Wide # Web at https://www.gnu.org/copyleft/gpl.html, or write to the Free # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, # MA 02110-1301, USA. package DUCK::systemd; use strict; use warnings; use autodie; use Path::Class; use Config::IniFiles; use Cwd 'abs_path'; use Regexp::Common qw /URI/; my @files; my %options=( "S" => " -S\t\tskip processing of systemd target files"); sub opts() { return keys %options; } sub desc() { my $r; foreach (sort keys %options) { $r.=$options{$_}."\n"; } return $r; } sub run() { my ($sname,$params,$entries_ref)=@_; my %opt=%$params; if (!$opt{S} ) { #get list of all systemd relevant files dir('.')->recurse( callback => sub { my $file=shift; # list of suffixes taken from http://www.freedesktop.org/software/systemd/man/systemd.unit.html if ($file =~ /(\.service$|\.socket$|\.device$|\.mount$|\.automount$|\.swap$|\.target$|\.path$|\.timer$|\.snapshot$|\.slice$|\.scope$)/ ) { push (@files,$file); } } ); } foreach my $f (@files) { my @urllist; my $cfg = Config::IniFiles->new(-file => abs_path($f)); if (!$cfg) { next; } my @values = $cfg->val('Unit', 'Documentation'); if (!@values) {next;} foreach my $url (@values) { my @split=split(/\s+/,$url); push (@urllist,@split); } foreach my $url (@urllist) { if ($url =~ /($RE{URI}{HTTP}{-keep}{-scheme =>'https?'})/ || $url =~ /($RE{URI}{HTTP}{-keep}{-scheme =>'ftp'})/ ) { my $check_method="URL"; my $guess_info=""; my $certainty="possible"; my $verbose="$f: [Unit] Documentation=$url"; push (@$entries_ref, [$guess_info.$f,$check_method,$url,$url, {filename => $f, checkmethod =>$check_method, orig_line => "origline", url=>$url, verbose =>$verbose, certainty=>$certainty} ]); } } } return; } 1;