7812 lines · 233.1 KB · Perl
RawDownload
#!/usr/bin/env perl# SPDX-License-Identifier: GPL-2.0## (c) 2001, Dave Jones. (the file handling bit)# (c) 2005, Joel Schopp <jschopp@austin.ibm.com> (the ugly bit)# (c) 2007,2008, Andy Whitcroft <apw@uk.ibm.com> (new conditions, test suite)# (c) 2008-2010 Andy Whitcroft <apw@canonical.com># (c) 2010-2018 Joe Perches <joe@perches.com> use strict;use warnings;use POSIX;use File::Basename;use Cwd 'abs_path';use Term::ANSIColor qw(:constants);use Encode qw(decode encode); my $P = $0;my $D = dirname(abs_path($P)); my $V = '0.32'; use Getopt::Long qw(:config no_auto_abbrev); my $quiet = 0;my $verbose = 0;my %verbose_messages = ();my %verbose_emitted = ();my $tree = 1;my $chk_signoff = 1;my $chk_fixes_tag = 1;my $chk_patch = 1;my $tst_only;my $emacs = 0;my $terse = 0;my $showfile = 0;my $file = 0;my $git = 0;my %git_commits = ();my $check = 0;my $check_orig = 0;my $summary = 1;my $mailback = 0;my $summary_file = 0;my $show_types = 0;my $list_types = 0;my $fix = 0;my $fix_inplace = 0;my $root;my $gitroot = $ENV{'GIT_DIR'};$gitroot = ".git" if !defined($gitroot);my %debug;my %camelcase = ();my %use_type = ();my @use = ();my %ignore_type = ();my @ignore = ();my $help = 0;my $configuration_file = ".checkpatch.conf";my $max_line_length = 100;my $ignore_perl_version = 0;my $minimum_perl_version = 5.10.0;my $min_conf_desc_length = 4;my $spelling_file = "$D/spelling.txt";my $codespell = 0;my $codespellfile = "/usr/share/codespell/dictionary.txt";my $user_codespellfile = "";my $conststructsfile = "$D/const_structs.checkpatch";my $docsfile = "$D/../Documentation/dev-tools/checkpatch.rst";my $typedefsfile;my $color = "auto";my $allow_c99_comments = 1; # Can be overridden by --ignore C99_COMMENT_TOLERANCE# git output parsing needs US English output, so first set backtick child process LANGUAGEmy $git_command ='export LANGUAGE=en_US.UTF-8; git';my $tabsize = 8;my ${CONFIG_} = "CONFIG_"; my %maybe_linker_symbol; # for externs in c exceptions, when seen in *vmlinux.lds.h sub help {	my ($exitcode) = @_; 	print << "EOM";Usage: $P [OPTION]... [FILE]...Version: $V Options:  -q, --quiet                quiet  -v, --verbose              verbose mode  --no-tree                  run without a kernel tree  --no-signoff               do not check for 'Signed-off-by' line  --no-fixes-tag             do not check for 'Fixes:' tag  --patch                    treat FILE as patchfile (default)  --emacs                    emacs compile window format  --terse                    one line per report  --showfile                 emit diffed file position, not input file position  -g, --git                  treat FILE as a single commit or git revision range                             single git commit with:                               <rev>                               <rev>^                               <rev>~n                             multiple git commits with:                               <rev1>..<rev2>                               <rev1>...<rev2>                               <rev>-<count>                             git merges are ignored  -f, --file                 treat FILE as regular source file  --subjective, --strict     enable more subjective tests  --list-types               list the possible message types  --types TYPE(,TYPE2...)    show only these comma separated message types  --ignore TYPE(,TYPE2...)   ignore various comma separated message types  --show-types               show the specific message type in the output  --max-line-length=n        set the maximum line length, (default $max_line_length)                             if exceeded, warn on patches                             requires --strict for use with --file  --min-conf-desc-length=n   set the min description length, if shorter, warn  --tab-size=n               set the number of spaces for tab (default $tabsize)  --root=PATH                PATH to the kernel tree root  --no-summary               suppress the per-file summary  --mailback                 only produce a report in case of warnings/errors  --summary-file             include the filename in summary  --debug KEY=[0|1]          turn on/off debugging of KEY, where KEY is one of                             'values', 'possible', 'type', and 'attr' (default                             is all off)  --test-only=WORD           report only warnings/errors containing WORD                             literally  --fix                      EXPERIMENTAL - may create horrible results                             If correctable single-line errors exist, create                             "<inputfile>.EXPERIMENTAL-checkpatch-fixes"                             with potential errors corrected to the preferred                             checkpatch style  --fix-inplace              EXPERIMENTAL - may create horrible results                             Is the same as --fix, but overwrites the input                             file.  It's your fault if there's no backup or git  --ignore-perl-version      override checking of perl version.  expect                             runtime errors.  --codespell                Use the codespell dictionary for spelling/typos                             (default:$codespellfile)  --codespellfile            Use this codespell dictionary  --typedefsfile             Read additional types from this file  --color[=WHEN]             Use colors 'always', 'never', or only when output                             is a terminal ('auto'). Default is 'auto'.  --kconfig-prefix=WORD      use WORD as a prefix for Kconfig symbols (default                             ${CONFIG_})  -h, --help, --version      display this help and exit When FILE is - read standard input.EOM 	exit($exitcode);} sub uniq {	my %seen;	return grep { !$seen{$_}++ } @_;} sub list_types {	my ($exitcode) = @_; 	my $count = 0; 	local $/ = undef; 	open(my $script, '<', abs_path($P)) or	    die "$P: Can't read '$P' $!\n"; 	my $text = <$script>;	close($script); 	my %types = ();	# Also catch when type or level is passed through a variable	while ($text =~ /(?:(\bCHK|\bWARN|\bERROR|&\{\$msg_level})\s*\(|\$msg_type\s*=)\s*"([^"]+)"/g) {		if (defined($1)) {			if (exists($types{$2})) {				$types{$2} .= ",$1" if ($types{$2} ne $1);			} else {				$types{$2} = $1;			}		} else {			$types{$2} = "UNDETERMINED";		}	} 	print("#\tMessage type\n\n");	if ($color) {		print(" ( Color coding: ");		print(RED . "ERROR" . RESET);		print(" | ");		print(YELLOW . "WARNING" . RESET);		print(" | ");		print(GREEN . "CHECK" . RESET);		print(" | ");		print("Multiple levels / Undetermined");		print(" )\n\n");	} 	foreach my $type (sort keys %types) {		my $orig_type = $type;		if ($color) {			my $level = $types{$type};			if ($level eq "ERROR") {				$type = RED . $type . RESET;			} elsif ($level eq "WARN") {				$type = YELLOW . $type . RESET;			} elsif ($level eq "CHK") {				$type = GREEN . $type . RESET;			}		}		print(++$count . "\t" . $type . "\n");		if ($verbose && exists($verbose_messages{$orig_type})) {			my $message = $verbose_messages{$orig_type};			$message =~ s/\n/\n\t/g;			print("\t" . $message . "\n\n");		}	} 	exit($exitcode);} my $conf = which_conf($configuration_file);if (-f $conf) {	my @conf_args;	open(my $conffile, '<', "$conf")	    or warn "$P: Can't find a readable $configuration_file file $!\n"; 	while (<$conffile>) {		my $line = $_; 		$line =~ s/\s*\n?$//g;		$line =~ s/^\s*//g;		$line =~ s/\s+/ /g; 		next if ($line =~ m/^\s*#/);		next if ($line =~ m/^\s*$/); 		my @words = split(" ", $line);		foreach my $word (@words) {			last if ($word =~ m/^#/);			push (@conf_args, $word);		}	}	close($conffile);	unshift(@ARGV, @conf_args) if @conf_args;} sub load_docs {	open(my $docs, '<', "$docsfile")	    or warn "$P: Can't read the documentation file $docsfile $!\n"; 	my $type = '';	my $desc = '';	my $in_desc = 0; 	while (<$docs>) {		chomp;		my $line = $_;		$line =~ s/\s+$//; 		if ($line =~ /^\s*\*\*(.+)\*\*$/) {			if ($desc ne '') {				$verbose_messages{$type} = trim($desc);			}			$type = $1;			$desc = '';			$in_desc = 1;		} elsif ($in_desc) {			if ($line =~ /^(?:\s{4,}|$)/) {				$line =~ s/^\s{4}//;				$desc .= $line;				$desc .= "\n";			} else {				$verbose_messages{$type} = trim($desc);				$type = '';				$desc = '';				$in_desc = 0;			}		}	} 	if ($desc ne '') {		$verbose_messages{$type} = trim($desc);	}	close($docs);} # Perl's Getopt::Long allows options to take optional arguments after a space.# Prevent --color by itself from consuming other argumentsforeach (@ARGV) {	if ($_ eq "--color" || $_ eq "-color") {		$_ = "--color=$color";	}} GetOptions(	'q|quiet+'	=> \$quiet,	'v|verbose!'	=> \$verbose,	'tree!'		=> \$tree,	'signoff!'	=> \$chk_signoff,	'fixes-tag!'	=> \$chk_fixes_tag,	'patch!'	=> \$chk_patch,	'emacs!'	=> \$emacs,	'terse!'	=> \$terse,	'showfile!'	=> \$showfile,	'f|file!'	=> \$file,	'g|git!'	=> \$git,	'subjective!'	=> \$check,	'strict!'	=> \$check,	'ignore=s'	=> \@ignore,	'types=s'	=> \@use,	'show-types!'	=> \$show_types,	'list-types!'	=> \$list_types,	'max-line-length=i' => \$max_line_length,	'min-conf-desc-length=i' => \$min_conf_desc_length,	'tab-size=i'	=> \$tabsize,	'root=s'	=> \$root,	'summary!'	=> \$summary,	'mailback!'	=> \$mailback,	'summary-file!'	=> \$summary_file,	'fix!'		=> \$fix,	'fix-inplace!'	=> \$fix_inplace,	'ignore-perl-version!' => \$ignore_perl_version,	'debug=s'	=> \%debug,	'test-only=s'	=> \$tst_only,	'codespell!'	=> \$codespell,	'codespellfile=s'	=> \$user_codespellfile,	'typedefsfile=s'	=> \$typedefsfile,	'color=s'	=> \$color,	'no-color'	=> \$color,	#keep old behaviors of -nocolor	'nocolor'	=> \$color,	#keep old behaviors of -nocolor	'kconfig-prefix=s'	=> \${CONFIG_},	'h|help'	=> \$help,	'version'	=> \$help) or $help = 2; if ($user_codespellfile) {	# Use the user provided codespell file unconditionally	$codespellfile = $user_codespellfile;} elsif (!(-f $codespellfile)) {	# If /usr/share/codespell/dictionary.txt is not present, try to find it	# under codespell's install directory: <codespell_root>/data/dictionary.txt	if (($codespell || $help) && which("python3") ne "") {		my $python_codespell_dict = << "EOF"; import os.path as opimport codespell_libcodespell_dir = op.dirname(codespell_lib.__file__)codespell_file = op.join(codespell_dir, 'data', 'dictionary.txt')print(codespell_file, end='')EOF 		my $codespell_dict = `python3 -c "$python_codespell_dict" 2> /dev/null`;		$codespellfile = $codespell_dict if (-f $codespell_dict);	}} # $help is 1 if either -h, --help or --version is passed as option - exitcode: 0# $help is 2 if invalid option is passed - exitcode: 1help($help - 1) if ($help); die "$P: --git cannot be used with --file or --fix\n" if ($git && ($file || $fix));die "$P: --verbose cannot be used with --terse\n" if ($verbose && $terse); if ($color =~ /^[01]$/) {	$color = !$color;} elsif ($color =~ /^always$/i) {	$color = 1;} elsif ($color =~ /^never$/i) {	$color = 0;} elsif ($color =~ /^auto$/i) {	$color = (-t STDOUT);} else {	die "$P: Invalid color mode: $color\n";} load_docs() if ($verbose);list_types(0) if ($list_types); $fix = 1 if ($fix_inplace);$check_orig = $check; my $exit = 0; my $perl_version_ok = 1;if ($^V && $^V lt $minimum_perl_version) {	$perl_version_ok = 0;	printf "$P: requires at least perl version %vd\n", $minimum_perl_version;	exit(1) if (!$ignore_perl_version);} #if no filenames are given, push '-' to read patch from stdinif ($#ARGV < 0) {	push(@ARGV, '-');} # skip TAB size 1 to avoid additional checks on $tabsize - 1die "$P: Invalid TAB size: $tabsize\n" if ($tabsize < 2); sub hash_save_array_words {	my ($hashRef, $arrayRef) = @_; 	my @array = split(/,/, join(',', @$arrayRef));	foreach my $word (@array) {		$word =~ s/\s*\n?$//g;		$word =~ s/^\s*//g;		$word =~ s/\s+/ /g;		$word =~ tr/[a-z]/[A-Z]/; 		next if ($word =~ m/^\s*#/);		next if ($word =~ m/^\s*$/); 		$hashRef->{$word}++;	}} sub hash_show_words {	my ($hashRef, $prefix) = @_; 	if (keys %$hashRef) {		print "\nNOTE: $prefix message types:";		foreach my $word (sort keys %$hashRef) {			print " $word";		}		print "\n";	}} hash_save_array_words(\%ignore_type, \@ignore);hash_save_array_words(\%use_type, \@use); my $dbg_values = 0;my $dbg_possible = 0;my $dbg_type = 0;my $dbg_attr = 0;for my $key (keys %debug) {	## no critic	eval "\${dbg_$key} = '$debug{$key}';";	die "$@" if ($@);} my $rpt_cleaners = 0; if ($terse) {	$emacs = 1;	$quiet++;} if ($tree) {	if (defined $root) {		if (!top_of_kernel_tree($root)) {			die "$P: $root: --root does not point at a valid tree\n";		}	} else {		if (top_of_kernel_tree('.')) {			$root = '.';		} elsif ($0 =~ m@(.*)/scripts/[^/]*$@ &&						top_of_kernel_tree($1)) {			$root = $1;		}	} 	if (!defined $root) {		print "Must be run from the top-level dir. of a kernel tree\n";		exit(2);	}} my $emitted_corrupt = 0; our $Ident	= qr{			[A-Za-z_][A-Za-z\d_]*			(?:\s*\#\#\s*[A-Za-z_][A-Za-z\d_]*)*		}x;our $Storage	= qr{extern|static|asmlinkage};our $Sparse	= qr{			__user|			__kernel|			__force|			__iomem|			__must_check|			__kprobes|			__ref|			__refconst|			__refdata|			__rcu|			__private		}x;our $InitAttributePrefix = qr{__(?:mem|cpu|dev|net_|)};our $InitAttributeData = qr{$InitAttributePrefix(?:initdata\b)};our $InitAttributeConst = qr{$InitAttributePrefix(?:initconst\b)};our $InitAttributeInit = qr{$InitAttributePrefix(?:init\b)};our $InitAttribute = qr{$InitAttributeData|$InitAttributeConst|$InitAttributeInit}; # Notes to $Attribute:# We need \b after 'init' otherwise 'initconst' will cause a false positive in a checkour $Attribute	= qr{			const|			volatile|			__percpu|			__nocast|

Lines 1–500 of 7812.