#!/usr/bin/perl
#
# RUStrings v0.1, written by Hexacorn.com, 2012-02
#
# This is a simple script that attempts to extract ANSI, Unicode,
# and Russian strings from file(s)
#
# Note: it scans directories recursively
#
# Usage:
#      perl RUStrings.pl <filename or directory>

use strict;
use warnings;

$| = 1;

my $r1 = "\xA3\xB3\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA\xFB\xFC\xFD\xFE\xFF";
my $r2 = "\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xb5\xb6\xb7\xb8\xbd\xbe\xc6\xc7\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xdd\xde\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc";
my $r3 = "\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7";
my $r4 = "\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfe\xff";

my $READSIZE = 65536*4;

print STDERR "
===================================================================
 RUStrings v0.1, written by Hexacorn.com, 2012-02
===================================================================
";

    my $target = shift or die "\n\nError: Gimme a filename or dir (use '.' for a current directory)!\n";

       if (-d $target)
       {
          scan ($target);
       }
    elsif (-f $target)
       {
          processonefile ($target);
       }
    else
       {
          print "\n\nError: Don't know what to do with '$target'!\n";
       }

    exit(0);

######################
sub scan
    {
        my $subdir = shift;

        $subdir =~ s/^\.\///;

        print   STDERR "Processing  directory: '$subdir'\n";

        opendir(DIR, $subdir);
        my @sorted_subdir = sort readdir DIR;
        closedir DIR;

        foreach my $filename (@sorted_subdir)
           {
                next if $filename =~ /^\.{1,2}$/;

                my $fullpath = $subdir.'/'.$filename;

                if (-d $fullpath)
                   {
                       scan ($fullpath);
                       next;
                   }

                processonefile ($fullpath);
           }
    }

######################
sub processonefile
    {
        my $file = shift;

        print   STDERR "Processing file: '$file'!\n";

        if (! -f $file)
            {
                print STDERR " -> Can't be found! (check attributes/access rights)\n";
                return;
            }

        my $filesize = -s $file;

        if ($filesize == 0)
            {
                print STDERR " -> Skipping cuz it's empty !\n";
                return;
            }

        my $data = readfile ($file, 0, $filesize);

        my $datalen = length($data);
        if ($filesize != $datalen)
            {
                print STDERR " -> Skipping cuz something funny happened during data reading (investigate)!\n";
                return;
            }

        my $cnt = 0;
        while ($data =~ /([ -~]{4,}|([ -~]\x00){4,}|[$r1]{4}[ $r1]+|[$r2]{4}[ $r2]+|[$r3]{4}[ $r3]+|[$r4]{4}[ $r4]+)/sg)
        {
           my $string = $1;
           $string =~ s/\x00//gs if $string =~ /([ -~]\x00){4,}/s;
           print "$string\n";
           $cnt++;
        }

        print   STDERR " -> Nothing found!\n" if $cnt == 0;
        print   STDERR " -> $cnt string(s) found!\n" if $cnt > 0;
    }

sub readfile
    {
        my $file = shift;
        my $ofs  = shift;
        my $siz  = shift;

        return  '' if !-f $file;

        open    (FILE, '<'.$file);
        binmode (FILE);
        seek    (FILE, $ofs, 0);
        read    (FILE, my $data, $siz);
        close   (FILE);

        return $data;
    }