# duck - check for DEP-3 patch 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::patch_files; 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 Path::Class; use File::Basename; use DUCK; my @patchdirs; my @patchfiles; my @extract_patch=("Origin", "Bug", "Forwarded", "Applied-Upstream", "Author", "From", "Reviewed-by", "Acked-by"); my %options=( "P" => " -P\t\tskip processing of patch 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; my $extract_patch_hash; foreach my $a (@extract_patch) { $extract_patch_hash->{$a}=1; } if (!$opt{P} ) { ########### processing patch files ## get list of dirs which contain a series file dir('.')->recurse( callback => sub { my $file=shift; if ($file =~ /\/series$/ ) { my $dirname=dirname($file); # print "found series: $file in $dirname\n"; push @patchdirs,$dirname; } } ); # iterate over all patchdirs, process all files found foreach my $patchdir (@patchdirs) { my $dirhandle=dir($patchdir)->open; while (my $patchfile = $dirhandle->read) { open my $pf,"<",$patchdir."/".$patchfile; my @pf_raw=<$pf>; close($pf); my $linenum=0; foreach my $pline (@pf_raw) { $linenum++; chomp $pline; last if ( $pline =~ /---/); (my $pfield,my $pdata)=split /:\s+/,$pline; if ($pfield) { foreach my $ex (@extract_patch) { if ($pfield =~/$ex/) { if ($pdata) { my $cc=DUCK->extract_url($pdata); if ($cc) { push (@$entries_ref, ["$patchdir/$patchfile:".$linenum,"URL",$cc,$cc, {filename => "$patchdir/$patchfile", linenumber => $linenum, checkmethod =>"URL", url=>$cc, certainty=>"possible"} ]); next; } if ($pdata =~ /@/) { my $pdata_line_mangled =$pdata; $pdata_line_mangled =~ s/[\*\#|<>\(\)\/]/ /g; $pdata_line_mangled =~ s/\s\s*/ /g; next unless length($pdata_line_mangled); my @emails = ($pdata_line_mangled =~ /$RE{Email}{Address}{-keep}/go ); if (@emails && (!($pdata =~ /Message-id:/i ))) { my @parsed = map $_->address,Mail::Address->parse(@emails); foreach my $e (@parsed) { if (!split('.',(split('@',$e))[1])) {next;} my $e_a=$e; push (@$entries_ref, ["$patchdir/$patchfile:".$linenum,"Email",$e_a,$pdata, {filename => "$patchdir/$patchfile", linenumber => $linenum, checkmethod =>"Email", url=>$pdata_line_mangled, certainty=>"possible"} ]); } } } } } } } } } } } return; } 1;