Perl: running a user-specified s/// regex?

exscape · 03-12-2008, 02:42 PM

The idea is simple, but I'm not sure the implementation is.
Anyway, as part of my program, I want the user to be able to specify a regex, like:

Enter a string: ... blah blah ...
Enter a regex: s/blah/yawn/g

I've come that far, in fact. I can also use regex stuff on the left side, i.e. s/\b\w{5}\b/yawn/g.
However, I can't get backreferences to work. What'd be the ultimate thing is if the user could enter something like
s/blah (\w+) blah/$1/g

Is this possible? I've tried a bit with qr// and eval, but no luck. I'm pretty new to Perl, btw. So far, all it does is print the literal '$1' instead of the value I want.

osor · 03-12-2008, 03:01 PM

In general, this may be a security risk. To bypass security checking, put this at the beginning of your source file:

Code:

use re 'eval';

exscape · 03-12-2008, 03:24 PM

Quote:

Originally Posted by osor

In general, this may be a security risk. To bypass security checking, put this at the beginning of your source file:

Code:

use re 'eval';

Hmm, thanks, but unless I'm missing something (I hope so), it doesn't help.

Here's the (testing) code, and a sample run:

Code:

use strict;
use warnings;
use re 'eval';

print "Enter a regex: ";
chomp(my $regex = <STDIN>);
print "Enter a replacement: ";
chomp(my $repl = <STDIN>);
print "Regex: $regex\n";
print "Repl : $repl\n";

my $str = "A bunch of words to search and replace on";

print "Old: $str\n";

$str =~ s/$regex/$repl/g;

print "New: $str\n";

Quote:

Enter a regex: \b(\w{5})\b
Enter a replacement: >>$1<<
Regex: \b(\w{5})\b
Repl : >>$1<<
Old: A bunch of words to search and replace on
New: A >>$1<< of >>$1<< to search and replace on

It seems I had to split the regex for it to work. (To minimize bugs, I removed my split code and made it two lines for the test.)

osor · 03-12-2008, 04:53 PM

Quote:

Originally Posted by exscape

Hmm, thanks, but unless I'm missing something (I hope so), it doesn't help.

You’re right it won’t help. I misunderstood your question.

Does this work for you (btw, it still might be insecure in certain situations)?

Code:

#!/usr/bin/perl

use strict;
use warnings;

print "Enter a regex: ";
chomp(my $regex = <STDIN>);
print "Enter a replacement: ";
chomp(my $repl = <STDIN>);
print "Regex: $regex\n";
print "Repl : $repl\n";

my $str = "A bunch of words to search and replace on";

print "Old: $str\n";

eval "\$str =~ s/$regex/$repl/g;";

print "New: $str\n";

osor · 03-12-2008, 05:12 PM

Btw, this will also work (notice the peculiar forced quoting of $repl):

Code:

#!/usr/bin/perl

use strict;
use warnings;

print "Enter a regex: ";
chomp(my $regex = <STDIN>);
print "Enter a replacement: ";
chomp(my $repl = <STDIN>);
$repl = '"' . $repl . '"';
print "Regex: $regex\n";
print "Repl : $repl\n";

my $str = "A bunch of words to search and replace on";

print "Old: $str\n";

$str =~ s/$regex/$repl/gee;

print "New: $str\n";

osor · 03-12-2008, 05:13 PM

Ignore this.

exscape · 03-12-2008, 05:14 PM

I solved it!

Relevant parts:

Code:

my $regex = pop @ARGV;

my ($search, $repl, $flags) = ($1, $2, $3) if $regex =~ m{^s/(.*?)/(.*?)/(\w+)?};
$repl = "" unless defined $repl;
$flags = "" unless defined $flags;
die "Unable to read regex! ...blah...\n" unless (defined $search && defined $repl);

eval '$newname =~ s/$search/' . "$repl/$flags";
        die "Unable to execute substitution! Invalid regular expression?\nError message was: $@\n" if $@;

Works great!
I'm writing a mass-rename util. Fully functional by now!

Quote:

# Start with a bunch of kernel source files.

serenity@exscape ~/programming/perl/testing $ ls
aperture.c crash_dump.c head64.c ioport.c mce_amd.c pci-calgary.c process.c smpboot.c tce.c vsyscall.c
apic.c e820.c hpet.c irq.c mce.c pci-dma.c ptrace.c smp.c time.c x8664_ksyms.c
asm-offsets.c early_printk.c i387.c k8.c mce_intel.c pci-gart.c reboot.c stacktrace.c traps.c
audit.c early-quirks.c i8259.c kprobes.c module.c pci-nommu.c setup64.c suspend.c tsc.c
bugs.c genapic.c init_task.c ldt.c mpparse.c pci-swiotlb.c setup.c syscall.c tsc_sync.c
crash.c genapic_flat.c io_apic.c machine_kexec.c nmi.c pmtimer.c signal.c sys_x86_64.c vsmp.c

# Rename all to .c.old
serenity@exscape ~/programming/perl/testing $ perl ../massrename.pl * 's/.c$/.c.old/g'
serenity@exscape ~/programming/perl/testing $ ls
aperture.c.old e820.c.old i387.c.old kprobes.c.old mpparse.c.old pmtimer.c.old smpboot.c.old time.c.old
apic.c.old early_printk.c.old i8259.c.old ldt.c.old nmi.c.old process.c.old smp.c.old traps.c.old
asm-offsets.c.old early-quirks.c.old init_task.c.old machine_kexec.c.old pci-calgary.c.old ptrace.c.old stacktrace.c.old tsc.c.old
audit.c.old genapic.c.old io_apic.c.old mce_amd.c.old pci-dma.c.old reboot.c.old suspend.c.old tsc_sync.c.old
bugs.c.old genapic_flat.c.old ioport.c.old mce.c.old pci-gart.c.old setup64.c.old syscall.c.old vsmp.c.old
crash.c.old head64.c.old irq.c.old mce_intel.c.old pci-nommu.c.old setup.c.old sys_x86_64.c.old vsyscall.c.old
crash_dump.c.old hpet.c.old k8.c.old module.c.old pci-swiotlb.c.old signal.c.old tce.c.old x8664_ksyms.c.old

# Rename back to .c with underscore words swapped (genapic_flat -> flat_genapic)

serenity@exscape ~/programming/perl/testing $ perl ../massrename.pl * 's/(.*?)_(.*?).c.old/$2_$1.c/g'
serenity@exscape ~/programming/perl/testing $ ls
amd_mce.c crash.c.old hpet.c.old kexec_machine.c nmi.c.old printk_early.c smpboot.c.old tce.c.old
aperture.c.old dump_crash.c i387.c.old kprobes.c.old pci-calgary.c.old process.c.old smp.c.old time.c.old
apic.c.old e820.c.old i8259.c.old ksyms_x8664.c pci-dma.c.old ptrace.c.old stacktrace.c.old traps.c.old
apic_io.c early-quirks.c.old intel_mce.c ldt.c.old pci-gart.c.old reboot.c.old suspend.c.old tsc.c.old
asm-offsets.c.old flat_genapic.c ioport.c.old mce.c.old pci-nommu.c.old setup64.c.old sync_tsc.c vsmp.c.old
audit.c.old genapic.c.old irq.c.old module.c.old pci-swiotlb.c.old setup.c.old syscall.c.old vsyscall.c.old
bugs.c.old head64.c.old k8.c.old mpparse.c.old pmtimer.c.old signal.c.old task_init.c x86_64_sys.c

Is there an app like this out there? In any case I feel good at the moment, this will be used a lot by myself!

BTW, with the regex checker in the code above, is security still a concern?
I don't see how it'd matter, though, re 'eval' is off, and even if it was exploitable it wouldn't really matter; it's not like it's going to be setuid root or anything. If you can run perl -e 'eval "unlink $_ for <*>"' you can run rm -f * too...?

osor · 03-12-2008, 05:15 PM

For your mass rename tool, are you duplicating the functionality of rename?

exscape · 03-12-2008, 05:16 PM

Double post.

Anyway, yes, I'm duplicating that. Damnit.

Well, still time well spent learning!

chrism01 · 03-12-2008, 05:48 PM

These are 2 good tutorials

http://perldoc.perl.org/perlrequick.html - quick tutorial
http://perldoc.perl.org/perlretut.html - full tutorial

In re the OP etc, look at the \Q ...\E construct in the 2nd tutorial