# duck - check for debian/copyright files # 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::copyright_file; use strict; use warnings; use autodie; use Data::Dumper; use Parse::DebControl qw(parse_file); use Regexp::Common qw /URI Email::Address/; use Mail::Address; use DUCK; my %options=( "c:" => " -c file\tspecify path to copyright file", "C" => " -C\t\tskip processing of copyright file"); 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{c}) { if (! -r $opt{c}) { print STDERR "Unable to open user-specified copyright file: ".$opt{c}."\n"; exit(2); } } if (!$opt{c}) { if (! -r "debian/copyright") { return; } } if (!$opt{C}) { #processing copyright file my $copy_fn=($opt{c} or "debian/copyright"); my @copy_raw; if (open my $fh,"<",$copy_fn) { @copy_raw=<$fh>; close($fh); chomp @copy_raw; } my $linenum=0; foreach my $copyright_line (@copy_raw) { $linenum++; $copyright_line =~ s/^[*\s#\-|\/\.]*//; $copyright_line =~ s/[\s#\-|\)*]*$//; next unless length($copyright_line); my $cc=DUCK->extract_url($copyright_line); if ($cc) { my $copyright_line_mangled =$cc; $copyright_line_mangled =~ s/,$//; #Strip trailing commas. my $check_method="URL"; my $guess_info=""; my $certainty="possible"; my $verbose=""; my $svn_string=$copyright_line; my $rep= quotemeta $copyright_line_mangled; $svn_string =~ s/$rep/x/g; if ($svn_string =~ /\s*svn\s*/) { $check_method="SVN"; $guess_info="(SVN method guessed) "; $certainty="wild-guess"; } push (@$entries_ref, [$guess_info.$copy_fn.":".$linenum,$check_method,$copyright_line_mangled,$copyright_line, {filename => $copy_fn, linenumber => $linenum, checkmethod =>$check_method, orig_line => $copyright_line, url=>$copyright_line_mangled, verbose =>$verbose, certainty=>$certainty} ]); } else { if ($copyright_line =~ /[^\s.]@[^\s.]/) { my $copyright_line_mangled =$copyright_line; $copyright_line_mangled =~ s/[\*\#|<>\(\)\/]/ /g; $copyright_line_mangled =~ s/\s\s*/ /g; next unless length($copyright_line_mangled); my @emails = ($copyright_line_mangled =~ /$RE{Email}{Address}{-keep}/go ); if (@emails && (!($copyright_line =~ /Message-id:/i ))) { my @parsed = map $_->address,Mail::Address->parse(@emails); foreach (@parsed) { push (@$entries_ref, [$copy_fn.":".$linenum,"Email",$_,$copyright_line_mangled, {filename => $copy_fn, linenumber => $linenum, checkmethod =>"Email", orig_line => $copyright_line, url=>$_, # verbose =>'$verbose', certainty=>"possible"} ]); } } } } } } return; } 1;