michael@428: ##
michael@428: ##  lint-rc.pl -- OpenPKG rc.* File Checker
michael@428: ##  Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/>
michael@428: ##
michael@428: ##  This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
michael@428: ##  All rights reserved. Licenses which grant limited permission to use,
michael@428: ##  copy, modify and distribute this software are available from the
michael@428: ##  OpenPKG GmbH.
michael@428: ##
michael@428: ##  THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
michael@428: ##  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
michael@428: ##  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
michael@428: ##  IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
michael@428: ##  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
michael@428: ##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
michael@428: ##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
michael@428: ##  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
michael@428: ##  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
michael@428: ##  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
michael@428: ##  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
michael@428: ##  SUCH DAMAGE.
michael@428: ##
michael@428: 
michael@428: #   Perl run-time requirement
michael@428: require 5;
michael@428: BEGIN {
michael@428:     eval "use Getopt::Long; use IO;";
michael@428:     if ($@) {
michael@428:         print STDERR
michael@428:             "lint-rc: ERROR: This command requires a full-size Perl installation!\n" .
michael@428:             "lint-rc: HINT:  Install OpenPKG \"perl\" package to use this command.\n";
michael@428:         exit(1);
michael@428:     }
michael@428: }
michael@428: 
michael@428: #   OpenPKG instance prefix
michael@428: my $my_prefix = $ENV{'OPENPKG_PREFIX'};
michael@428: delete $ENV{'OPENPKG_PREFIX'};
michael@428: 
michael@428: #   program information
michael@428: my $progname = "lint-rc";
michael@428: my $progvers = "1.0.0";
michael@428: 
michael@428: #   parameters (defaults)
michael@428: my $version  = 0;
michael@428: my $verbose  = 0;
michael@428: my $help     = 0;
michael@428: my $check    = 'all';
michael@428: my $tmpdir   = ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp") . "/$progname";
michael@428: my $rpm      = "$my_prefix/bin/openpkg rpm";
michael@428: 
michael@428: #   exception handling support
michael@428: $SIG{__DIE__} = sub {
michael@428:     my ($err) = @_;
michael@428:     $err =~ s|\s+at\s+.*||s if (not $verbose);
michael@428:     print STDERR "$progname:ERROR: $err ". ($! ? "($!)" : "") . "\n";
michael@428:     exit(1);
michael@428: };
michael@428: 
michael@428: #   command line parsing
michael@428: Getopt::Long::Configure("bundling");
michael@428: my $result = GetOptions(
michael@428:     'V|version'     => \$version,
michael@428:     'v|verbose'     => \$verbose,
michael@428:     'h|help'        => \$help,
michael@428:     'c|check=s'     => \$check,
michael@428:     't|tmpdir=s'    => \$tmpdir,
michael@428:     'r|rpm=s'       => \$rpm,
michael@428: ) || die "option parsing failed";
michael@428: if ($help) {
michael@428:     print "Usage: $progname [options] [RPMFILE ...]\n" .
michael@428:           "Available options:\n" .
michael@428:           " -v,--verbose       enable verbose run-time mode\n" .
michael@428:           " -h,--help          print out this usage page\n" .
michael@428:           " -c,--check=CHECKS  select checks to perform (default='all')\n" .
michael@428:           " -r,--rpm=FILE      filesystem path to RPM program\n" .
michael@428:           " -t,--tmpdir=PATH   filesystem path to temporary directory\n" .
michael@428:           " -V,--version       print program version\n";
michael@428:     exit(0);
michael@428: }
michael@428: if ($version) {
michael@428:     print "OpenPKG $progname $progvers\n";
michael@428:     exit(0);
michael@428: }
michael@428: 
michael@428: #   verbose message printing
michael@428: sub msg_verbose {
michael@428:     my ($msg) = @_;
michael@428:     print STDERR "$msg\n" if ($verbose);
michael@428: }
michael@428: 
michael@428: #   warning message printing
michael@428: sub msg_warning {
michael@428:     my ($msg) = @_;
michael@428:     print STDERR "$progname:WARNING: $msg\n";
michael@428: }
michael@428: 
michael@428: #   error message printing
michael@428: sub msg_error {
michael@428:     my ($msg) = @_;
michael@428:     print STDERR "$progname:ERROR: $msg\n";
michael@428: }
michael@428: 
michael@428: #   determine check list
michael@428: my @check_list = (qw(
michael@428:     blank
michael@428:     comment
michael@428:     section
michael@428:     script
michael@428:     global
michael@428: ));
michael@428: my @checks = ();
michael@428: if ($check eq 'all') {
michael@428:     @checks = @check_list;
michael@428: }
michael@428: else {
michael@428:     foreach my $c (split(/,/, $check)) {
michael@428:         if (not grep(/^$c$/, @check_list)) {
michael@428:             die "invalid check \"$c\"";
michael@428:         }
michael@428:         push(@checks, $c);
michael@428:     }
michael@428: }
michael@428: 
michael@428: #   global return code
michael@428: $main::GRC = 0;
michael@428: 
michael@428: #   environment preparation
michael@428: system("rm -rf $tmpdir");
michael@428: system("mkdir -p $tmpdir");
michael@428: 
michael@428: #   iterate over all rc. files
michael@428: foreach my $filename (@ARGV) {
michael@428:     my $io = new IO::File "<$filename"
michael@428:         or die "unable to open file \"$filename\" for reading";
michael@428:     my $spec; { local $/ = undef; $spec = <$io>; }
michael@428:     $io->close;
michael@428:     foreach my $check (@checks) {
michael@428:         &msg_verbose("$check in $filename");
michael@428:         eval "\&check_$check(\$filename, \$spec);";
michael@428:     }
michael@428: }
michael@428: 
michael@428: #   environment cleanup
michael@428: system("rm -rf $tmpdir");
michael@428: 
michael@428: #   die gracefully
michael@428: exit($main::GRC);
michael@428: 
michael@428: ##  _________________________________________________________________
michael@428: ##
michael@428: ##  COMMON SUBROUTINES
michael@428: ##  _________________________________________________________________
michael@428: ##
michael@428: 
michael@428: sub lines {
michael@428:     my ($txt) = @_;
michael@428:     my $l = 0;
michael@428:     $txt =~ s|\n|$l++, ''|sge;
michael@428:     return $l;
michael@428: }
michael@428: 
michael@428: sub lint_message {
michael@428:     my ($type, $file, $done, $this, $msg) = @_;
michael@428:     if (defined($done) and defined($this)) {
michael@428:         my $start = &lines($done) + 1;
michael@428:         my $end = $start + &lines($this);
michael@428:         my $pos = $start;
michael@428:         $pos .= "-". $end if ($end > $start);
michael@428:         printf("%s:%s: %s:%s: %s\n", $progname, $type, $file, $pos, $msg);
michael@428:     }
michael@428:     else {
michael@428:         printf("%s:%s: %s: %s\n", $progname, $type, $file, $msg);
michael@428:     }
michael@428: }
michael@428: 
michael@428: sub lint_warning {
michael@428:     my ($file, $done, $this, $msg) = @_;
michael@428:     &lint_message("WARNING", $file, $done, $this, $msg);
michael@428:     $main::GRC = 1 if ($main::GRC < 1);
michael@428: }
michael@428: 
michael@428: sub lint_error {
michael@428:     my ($file, $done, $this, $msg) = @_;
michael@428:     &lint_message("ERROR", $file, $done, $this, $msg);
michael@428:     $main::GRC = 2 if ($main::GRC < 2);
michael@428: }
michael@428: 
michael@428: ##  _________________________________________________________________
michael@428: ##
michael@428: ##  CHECK "blank": whitespace and blank lines
michael@428: ##  _________________________________________________________________
michael@428: ##
michael@428: 
michael@428: sub check_blank {
michael@428:     my ($file, $spec) = @_;
michael@428: 
michael@428:     #   check for CR-LF combination
michael@428:     my $done = ''; my $this = ''; my $todo = $spec;
michael@428:     while ($todo =~ m/\r\n/s) {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         &lint_warning($file, $done, $this, "carriage-return (CR, 0x0d) line-feed (NL, 0x0a) combination (expected just line-feed)");
michael@428:         $done .= $this;
michael@428:     }
michael@428: 
michael@428:     #   check for multiple blank lines
michael@428:     $done = ''; $this = ''; $todo = $spec;
michael@428:     while ($todo =~ m/(\r?\n[ \t]*){3,}/s) {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         &lint_warning($file, $done, $this, "multiple subsequent blank lines (expected single blank line)");
michael@428:         $done .= $this;
michael@428:     }
michael@428: 
michael@428:     #   check for trailing whitespaces
michael@428:     $done = ''; $this = ''; $todo = $spec;
michael@428:     while ($todo =~ m/[ \t]+\r?\n/s) {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         if ($done eq '' or $done =~ m|\n$|s) {
michael@428:             &lint_warning($file, $done, $this, "whitespace on empty line (expected none)");
michael@428:         }
michael@428:         else {
michael@428:             &lint_warning($file, $done, $this, "trailing whitespace (expected none)");
michael@428:         }
michael@428:         $done .= $this;
michael@428:     }
michael@428: 
michael@428:     #   check for bogus line continuations
michael@428:     $done = ''; $this = ''; $todo = $spec;
michael@428:     while ($todo =~ m/\\[ \t]*\r?\n(?=[ \t]*\r?\n)/s) {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         &lint_warning($file, $done, $this, "bogus line continuation for following empty line (expect no line continuation)");
michael@428:         $done .= $this;
michael@428:     }
michael@428: 
michael@428:     #   check for leading whitespaces before line continuations
michael@428:     $done = ''; $this = ''; $todo = $spec;
michael@428:     while ($todo =~ m/[ \t]{2,}\\[ \t]*\r?\n/s) {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         &lint_warning($file, $done, $this, "multiple leading whitespace before line continuation (expected just a single space)");
michael@428:         $done .= $this;
michael@428:     }
michael@428: 
michael@428:     #   check for leading tabs
michael@428:     $done = ''; $this = ''; $todo = $spec;
michael@428:     while ($todo =~ m/^ *\t+ *[^ \t]/m) {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         &lint_warning($file, $done, $this, "leading tabs (expected spaces)");
michael@428:         $done .= $this;
michael@428:     }
michael@428: 
michael@428:     #   check for mandatory/wished trailing blank line
michael@428:     if ($spec !~ m|\n\n$|s) {
michael@428:         &lint_warning($file, $done, "", "mandatory/wished trailing blank line at end of file missing (expected one)");
michael@428:     }
michael@428: }
michael@428: 
michael@428: ##  _________________________________________________________________
michael@428: ##
michael@428: ##  CHECK "comment": sharp-comments
michael@428: ##  _________________________________________________________________
michael@428: ##
michael@428: 
michael@428: sub check_comment {
michael@428:     my ($file, $spec) = @_;
michael@428:     my ($pkg);
michael@428: 
michael@428:     #   determine package name
michael@428:     $pkg = $file;
michael@428:     $pkg =~ s|^.+/||;
michael@428:     $pkg =~ s|^rc\.||;
michael@428: 
michael@428:     #   check "shebang" header
michael@428:     my $re = "";
michael@428:     $re .= "#!\@l_prefix\@/bin/openpkg rc\\n";
michael@428:     if ($spec !~ m|^$re|s) {
michael@428:         &lint_warning($file, "", "", "invalid shebang header (expected $re)");
michael@428:     }
michael@428: 
michael@428:     #   check comment header
michael@428:     my $re = "";
michael@428:     $re .= ".*?\\n##\\n##  rc.$pkg -- Run-Commands\\n##\\n\\n";
michael@428:     if ($pkg ne "openpkg" and $spec !~ m|^$re|s) {
michael@428:         &lint_warning($file, "", "", "invalid comment header (expected $re)");
michael@428:     }
michael@428: 
michael@428:     #   check for comment indentation
michael@428:     my $done .= $`; my $this = $&; my $todo = $';
michael@428:     while ($todo =~ m/^([ \t]*)(#+)([ \t]*)(.*?)$/m) {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         my ($lead, $sharp, $pad, $text) = ($1, $2, $3, $4);
michael@428:         if (length($lead) % 2 != 0) {
michael@428:             &lint_warning($file, $done, $this, "incorrect comment indentation (expected a multiple of 2 spaces)");
michael@428:         }
michael@428:         if (length($lead) > 1 && length($sharp) > 1) {
michael@428:             &lint_warning($file, $done, $this, "indented comment has introduced with multiple sharps (expected single sharp character)");
michael@428:         }
michael@428:         if (length($pad.$text) > 0 && length($sharp.$pad) % 4 != 0) {
michael@428:             &lint_warning($file, $done, $this, "incorrect comment text padding (expected a multiple of 4 sharps or spaces)");
michael@428:         }
michael@428:         if (length($pad) == 0 && length($text) > 0) {
michael@428:             &lint_warning($file, $done, $this, "missing leading space before comment text (expected padding spaces)");
michael@428:         }
michael@428:         if (length($pad) > 0 && length($text) == 0) {
michael@428:             &lint_warning($file, $done, $this, "empty comment text (expected a reasonable text)");
michael@428:         }
michael@428:         $done .= $this;
michael@428:     }
michael@428: }
michael@428: 
michael@428: ##  _________________________________________________________________
michael@428: ##
michael@428: ##  CHECK "section": run command sections
michael@428: ##  _________________________________________________________________
michael@428: ##
michael@428: 
michael@428: sub check_section {
michael@428:     my ($file, $spec) = @_;
michael@428: 
michael@428:     my $require = qq{
michael@428:         (%config,)?
michael@428:         (%common,)?
michael@428:         (%status,)?
michael@428:         (%info,)?
michael@428:         (%start,)?
michael@428:         (%stop,)?
michael@428:         (%restart,)?
michael@428:         (%reload,)?
michael@428:         (%quarterly,)?
michael@428:         (%hourly,)?
michael@428:         (%daily,)?
michael@428:         (%weekly,)?
michael@428:         (%monthly,)?
michael@428:         (%env,)?
michael@428:     };
michael@428: 
michael@428:     #   check for order of headers
michael@428:     my $sections = "";
michael@428:     my $done = ''; my $this = ''; my $todo = $spec;
michael@428:     while ($todo =~ m/^(\S+:|%\S+).*$/m) {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         my $section = $1;
michael@428:         $sections .= "$section,";
michael@428:         $done .= $this;
michael@428:     }
michael@428:     my $regex = $require;
michael@428:     $regex =~ s|\s+||sg;
michael@428:     if ($sections !~ m/^$regex$/s) {
michael@428:         $regex =~ s|,| |sg;
michael@428:         &lint_error($file, undef, undef, "invalid run command section order (expected \"$regex\")");
michael@428:     }
michael@428: }
michael@428: 
michael@428: ##  _________________________________________________________________
michael@428: ##
michael@428: ##  CHECK "script": shell scripts
michael@428: ##  _________________________________________________________________
michael@428: ##
michael@428: 
michael@428: sub check_script {
michael@428:     my ($file, $spec) = @_;
michael@428: 
michael@428:     my $done = ''; my $this = ''; my $todo = $spec;
michael@428:     while ($todo =~ m/(\%(?:config|info|common|status|start|stop|restart|reload|quarterly|hourly|daily|weekly|env))([^\n]*)\n(.*?\n)(?=\%(?:config|info|common|status|start|stop|restart|reload|quarterly|hourly|daily|weekly|env)|$)/s) {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         my ($section, $args, $script) = ($1, $2, $3);
michael@428: 
michael@428:         #   perform checks for a single script section
michael@428:         &check_script_section($file, $done, $this, $section, $args, $script);
michael@428: 
michael@428:         $done .= $this;
michael@428:     }
michael@428: }
michael@428: 
michael@428: sub check_script_section {
michael@428:     my ($file, $outer_done, $outer_this, $section, $args, $script) = @_;
michael@428:     my ($done, $this, $todo);
michael@428:     my ($pkg, $pkgu);
michael@428: 
michael@428:     #   determine package name
michael@428:     $pkg = $file;
michael@428:     $pkg =~ s|^.+/||;
michael@428:     $pkg =~ s|^rc\.||;
michael@428: 
michael@428:     #   determine package name, dash becomes underscore
michael@428:     $pkgu = $pkg;
michael@428:     $pkgu =~ s|-|_|;
michael@428: 
michael@428:     #   remove comment contents
michael@428:     $outer_this =~ s|^[ \t]*#[^\n]*\n||mg;
michael@428: 
michael@428:     #   check config
michael@428:     if ($section =~ m/^%(config)$/) {
michael@428: 
michael@428:         #   check for badly prefixed variables
michael@428:         $done = $outer_done; $this = ''; $todo = $outer_this;
michael@428:         while ($todo =~ m/    [^=]+=[^\n]+/s) {
michael@428:             $done .= $`; $this = $&; $todo = $';
michael@428:             if ($this !~ m/    ([A-Z]+|$pkgu)_[a-z_][a-z0-9_]*=/) {
michael@428:                 &lint_warning($file, $done, $this, "section $section: badly prefixed variable");
michael@428:             }
michael@428:             $done .= $this;
michael@428:         }
michael@428: 
michael@428:         #   enforce _enable to default to openpkg_rc_def
michael@428:         $done = $outer_done; $this = ''; $todo = $outer_this;
michael@428:         if ( $todo =~ m/    [^=]+_enable=[^\n]+/s and $todo !~ m/    [^=]+_enable="\$openpkg_rc_def"\n+/s) {
michael@428:             &lint_warning($file, $done, $this, "section $section: wrong default for ${pkgu}_enable");
michael@428:         }
michael@428: 
michael@428:         if ($pkg eq "openpkg") {
michael@428:             #   openpkg_rc before _enable, if used, must be the first variable
michael@428:             $done = $outer_done; $this = ''; $todo = $outer_this;
michael@428:             if ( $todo !~ m/%config\n(    [A-Z]+_[a-z_]+=[^\n]*\n)*    openpkg_rc_def=[^\n]+?\n    openpkg_rc_all=[^\n]+?\n    [^=]+_enable=[^\n]+/s) {
michael@428:                 &lint_warning($file, $done, $this, "section $section: openpkg_rc_def, openpkg_rc_all and ${pkgu}_enable must be the first lowercase variable");
michael@428:             }
michael@428:         }
michael@428:         else {
michael@428:             #   _enable, if used, must be the first variable
michael@428:             $done = $outer_done; $this = ''; $todo = $outer_this;
michael@428:             if ( $todo =~ m/    [^=]+_enable=[^\n]+/s and $todo !~ m/%config\n(    [A-Z]+_[a-z_]+=[^\n]*\n)*    [^=]+_enable=[^\n]+/s) {
michael@428:                 &lint_warning($file, $done, $this, "section $section: ${pkgu}_enable must be the first lowercase variable");
michael@428:             }
michael@428:         }
michael@428:     }
michael@428: 
michael@428:     if ($section =~ m/^%(config|info|status)$/) {
michael@428:         #   check illegal use of return/exit
michael@428:         $done = $outer_done; $this = ''; $todo = $outer_this;
michael@428:         if ( $todo =~ m/[^a-zA-Z0-9_](return|exit)\s/s ) {
michael@428:             &lint_warning($file, $done, $this, "section $section: return or exit not allowed here");
michael@428:         }
michael@428:         return;
michael@428:     }
michael@428: 
michael@428:     #   check rcService only used for enable|usable|active PR#232
michael@428:     $done = $outer_done; $this = ''; $todo = $outer_this;
michael@428:     while ( $todo =~ m/rcService\s+\w+\s+(\w+)/s )  {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         if ( $1 !~ m/^(enable|usable|active)$/ ) {
michael@428:             &lint_warning($file, $done, $this, "section $section: rcService must check for (enable|usable|active) only, found check for \"$1\"");
michael@428:         }
michael@428:         $done .= $this;
michael@428:     }
michael@428: 
michael@428:     #   check rcService short circuit
michael@428:     if ($section !~ m/^%(config|common|info)$/) {
michael@428:         $done = $outer_done; $this = ''; $todo = $outer_this;
michael@428:         if ( $todo !~ m/^[^\n]+\n    rcService $pkg enable yes \|\| exit 0\n/s ) {
michael@428:             &lint_warning($file, $done, $this, "section $section: \"rcService ... enable yes\" short circuit missing");
michael@428:         }
michael@428:         else {
michael@428:             #   check rcService package reference
michael@428:             $done = $outer_done; $this = ''; $todo = $outer_this;
michael@428:             if ( $todo !~ m/\brcService\s+$pkg\s+/s ) {
michael@428:                 &lint_warning($file, $done, $this, "section $section: rcService referencing wrong package");
michael@428:             }
michael@428:         }
michael@428:     }
michael@428: 
michael@428:     #   check shell redirections
michael@428:     $done = $outer_done; $this = ''; $todo = $outer_this;
michael@428:     while (   $todo =~ m/[ \t]+(\d+)?[><][ \t]+\S+/s
michael@428:            or $todo =~ m/[ \t]+[><](\&\d+)?[ \t]+\S+/s) {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         &lint_warning($file, $done, $this, "section $section: whitespace after shell redirection (expected none)");
michael@428:         $done .= $this;
michael@428:     }
michael@428: }
michael@428: 
michael@428: ##  _________________________________________________________________
michael@428: ##
michael@428: ##  CHECK "global": globals
michael@428: ##  _________________________________________________________________
michael@428: ##
michael@428: 
michael@428: sub check_global {
michael@428:     my ($file, $spec) = @_;
michael@428: 
michael@428:     #   utility function: extract a single shell command
michael@428:     sub command_extract {
michael@428:         my ($script) = @_;
michael@428:         my $cmd = '';
michael@428:         while ($script ne '') {
michael@428:             $script =~ s/^([ \t]*'[^']*')/         $cmd .= $1, ''/se && next;
michael@428:             $script =~ s/^([ \t]*"[^"]*")/         $cmd .= $1, ''/se && next;
michael@428:             $script =~ s/^([ \t]*[^ \t;\)\\\r\n]+)/$cmd .= $1, ''/se && next;
michael@428:             $script =~ s/^([ \t]*\\[ \t]*\r?\n)/   $cmd .= $1, ''/se && next;
michael@428:             last;
michael@428:         }
michael@428:         return ($cmd, $script);
michael@428:     }
michael@428: 
michael@428:     #   check for deprecated use of opServiceEnabled function
michael@428:     my $done = ''; my $this = ''; my $todo = $spec;
michael@428:     while ($todo =~ m/\bopServiceEnabled\b/s) {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         &lint_warning($file, $done, $this, "deprecated usage of opServiceEnabled macro (expected rcService ... enable yes)");
michael@428:         $done .= $this;
michael@428:     }
michael@428: 
michael@428:     my $done = ''; my $this = ''; my $todo = $spec;
michael@428:     while ($todo =~ m/shtool\s+/s) {
michael@428:         $done .= $`; $this = $&; $todo = $';
michael@428:         ($this, $todo) = &command_extract($this . $todo);
michael@428: 
michael@428:         #   check for shtool options with no space before argument
michael@428:         my $subthis = $this;
michael@428:         $subthis =~ s/%{[^}]*?}//sg;
michael@428:         $subthis =~ s/'[^']*'//sg;
michael@428:         $subthis =~ s/"[^"]*"//sg;
michael@428:         $subthis =~ s/[;|&].*$//s; # catch command termination by semicolon, pipe, or, and;
michael@428:         if ($subthis =~ m/\s-[a-zA-Z]\S/) {
michael@428:             &lint_warning($file, $done, $this, "found use of shtool option with space omitted before argument");
michael@428:         }
michael@428:         $done .= $this;
michael@428:     }
michael@428: }