Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Stopping bad input (harder than sanitizing)

by Anonymous Monk
on Mar 08, 2021 at 02:33 UTC ( [id://11129308]=perlquestion: print w/replies, xml ) Need Help??

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

First my code

$search = $top->Entry ('-width' => 20, ) ->pack('-side' => 'left'); $search->bind('<KeyPress-Return>', \&search); sub search { SEARCH_GET: my ($search_pattern , $string ); $search_pattern = $search->get(); print "Pattern entered into Search-box is: $search_pattern\n " +; (goto SEARCH_GET) if (! (defined $search_pattern) ); # if <RET> + is entered by itself, then ignore it... if ( $search_pattern =~ /^([\w\s\-\:\_\d]+)$/ ) ## CHECK $sea +rch_pattern and untaint: { ## make sure it onl +y contains \w, '-' , ':' , '_' , and digits $string = $1; ## DON'T forget + 's -- space between prog and $arg print "\$string is untainted; \$string = $string \n "; } else { print "OOPS! data is tainted. TRY AGAIN...\n "; } . . . }

If the first char I enter into the search-box is <RET>, then the program freezes. BESIDES. What was entered? Was it \n or " " or undef? How do I catch a carriage-return that was entered by itself , and thus prevent the programs freezup?

Replies are listed 'Best First'.
Re: Stopping bad input (harder than sanitizing)
by kcott (Archbishop) on Mar 08, 2021 at 07:23 UTC

    See the Tk::Entry documentation. In particular, the -validate, -validatecommand and -invalidcommand options (in WIDGET-SPECIFIC OPTIONS) and the entire VALIDATION section.

    Also see the "Validated entries and password fields." examples in the Widget Demo.

    — Ken

      I think I made some progress:

      $search = $top->Entry ('-width' => 20, '-validate' => 'key', '-validatecommand' => sub {$_[1] =~/\w+/ +;} , '-invalidcommand' => sub {$top -> bell() + ;}, ) ->pack('-side' => 'left');

      I found the code on 'Mastering Perl/Tk' -- I modified it to work with my program. But I still need it to accept ':' and '-'. As for invalid input it should do something like this:

      '-invalidcommand' => sub {$_[1] =~/^[[:cntrl:]] ; $top -> bell; }
      But it sill locks up...

      2021-03-09 Athanasius added code tags around final snippet.

        You could use a character class to accept : and - in the validatecommand sub.

        '-validatecommand' => sub {$_[1] =~/[\w:-]+/ ;} ,

        WRT your invalidcommand sub, the regexp does nothing at the moment. Should the first line be something like this if you want to accept control characters?

        '-invalidcommand' => sub { return if $_[1] =~/^[[:cntrl:]] ; $top -> bell; }

        Or do you want the bell if it starts with a control character?

        '-invalidcommand' => sub { $top -> bell if $_[1] =~/^[[:cntrl:]] ; }

        I don't code with Tk, but hopefully this is useful.

Re: Stopping bad input (harder than sanitizing)
by swl (Parson) on Mar 08, 2021 at 07:11 UTC

    If $search->get() is returning undef on <RET> then change the condition in the goto line so it avoids an infinite loop.

    It's probably also useful to autoflush stdout to see the feedback as it is generated, rather than once the buffer is sufficiently full. See https://perldoc.perl.org/perlvar#$%7C.

    # somewhere in your code, perhaps in the search sub itself. local $| = 1;
Re: Stopping bad input (harder than sanitizing)
by tybalt89 (Monsignor) on Mar 10, 2021 at 19:10 UTC
    #!/usr/bin/perl use strict; use warnings; use Tk; $| = 1; my $search_pattern = ''; my $mw = MainWindow->new; $mw->geometry( '+700+300' ); my $search = $mw->Entry (-width => 20, -textvariable => \$search_patte +rn)->pack; $search->bind('<KeyPress-Return>', \&search); $search->focus; $mw->Button(-text => 'Clear', -command => sub {$search_pattern = ''})- +>pack; $mw->Button(-text => 'Exit', -command => sub {$mw->destroy})->pack; MainLoop; sub search { my ($string ); print "Pattern entered into Search-box is: $search_pattern\n "; use Data::Dump 'dd'; dd 'got', [ $search_pattern ]; ## CHECK $search_pattern and untaint: if( $search_pattern =~ /^([\w\s\-\:\_\d]+)$/ ) { ## make sure it only contains \w, '-' , ':' , '_' , and digits $string = $1; ## DON'T forget 's -- space between prog and $arg print "\$string is untainted; \$string = $string \n "; } else { print "OOPS! data is tainted or empty. TRY AGAIN...\n "; } }

      I just noticed the code you posted. I tried it - it works the way I want. I am gonna play with it, and see if it can be added to my program. Thanks.

      I got your code incorporated. Your code is quite simple. I am working on something thats quite large (1000 lines). Should $| be at the beginning of the program? If I enter '[' in the Tk::Entry widget I get "stack moved" error. If I promptly hit <RET> it still freezes. I pass data to $search_pattern via <code? $search_pattern = $entry -> get(); </code> Ideas?

Re: Stopping bad input (harder than sanitizing)
by jcb (Parson) on Mar 09, 2021 at 00:20 UTC

    Your immediate problem is simple: sub search goes into an infinite loop if $search_pattern is undefined. Instead of a goto, simply return early, as in return unless defined $search_pattern; which will cause the Tk event loop to resume and the UI to wait for the user to try again.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11129308]
Approved by GrandFather
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (5)
As of 2024-04-19 16:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found