package input_lib;
use CGI::Carp "fatalsToBrowser";

@ISA = qw(Exporter);

@EXPORT = qw (
input_validate
);

my $required = 0;

sub input_validate{
    my ($value, $rules) = @_;

    use Data::Dumper;
	$required = 0;
	my @error_messages;

    my @rules = split('\|', $rules);
    foreach my $rule (@rules)
    {
        # Extract the rules and param (if there is a param)
        # e.g. max_length[5]
        @match = ($rule =~ m/(\w+)\[(\d+)\]{0,1}/g);
        if(!@match)
        {
            @match = ($rule =~ m/(\w+)/g);
        }
        my ($rule, $param);

        if(scalar(@match) > 1)
        {
            $rule = $match[0];
            $param = $match[1];
        }
        elsif(scalar(@match) > 0)
        {
            $rule = $match[0];
        }
        else
        {
            die("Error: No rule");
        }

        # Execute the rules
        # Call a subroutine dynamically
        # my $test = "alpha";
        # *{$test}{CODE}->(); // Calls the subroutine "alpha" i.e. alpha();

        if(!*{$rule}{CODE}->($value, $param))
        {
            push @error_messages, $rule;
        }
    }

    if($required == 0 && $value eq "")
    {
        return 0;
    }
    elsif(scalar(@error_messages))
    {
        return 1;
    }
    else
    {
        return 0;
    }
}

sub required{
    my ($value) = @_;
    $required = 1;
    return ($value) ? 1:0;
}

sub alpha{
    my ($value) = @_;
    return (($value =~ /^([a-z])+$/i)) ? 1:0;
}

sub alpha_space{
    my ($value) = @_;
    return (($value =~ /^([a-z\s])+$/i)) ? 1:0;
}

sub alpha_numeric{
    my ($value) = @_;
    return ($value =~ /^([a-z,0-9\s])+$/i) ? 1:0;
}

sub max_length{
    my ($value, $length) = @_;
    return (length($value) <= $length) ? 1:0;
}

sub min_length{
    my ($value, $length) = @_;
    return (length($value) >= $length) ? 1:0;
}

sub integer{
    my ($value) = @_;
    return (($value =~ /^[\-+]?[0-9]+$/)) ? 1:0;
}

sub valid_email{
    my ($value) = @_;
    return (($value =~ /^([a-z0-9\+_\-]+)(\.[a-z0-9\+_\-]+)*@([a-z0-9\-]+\.)+[a-z]{2,6}$/ix)) ? 1:0;
}

sub valid_time{
	my ($time) = @_;
	if(!($time =~ m/([0-9]{2})\:([0-9]{2})/)){ return 0; }

	my ($hour, $min) = split(/\:/, $time);
	if($hour eq "" or $min eq ""){ return 0; }
	if($hour > 23 or $hour < 0){ return 0; }
	if($min > 59 or $min < 0){ return 0; }

	return 1;
}

sub valid_date{
	my ($date) = @_; # receives dd/mm/yyyy

	my ($day, $month, $year) = split(/\//, $date);
	if($day eq ""){ return 0; }
	if($month eq "") { return 0; }
	if($year eq "") { return 0; }

	$date = $month . '/' . $day . '/' . $year;

        # taken from OWASP's regex repository, http://www.owasp.org/index.php/OWASP_Validation_Regex_Repository
	# regex only supports mm/dd/yyyy
	if(!($date =~ m/^(?:(?:(?:0?[13578]|1[02])(\/|-|\.)31)\1|(?:(?:0?[1,3-9]|1[0-2])(\/|-|\.)(?:29|30)\2))(?:(?:1[6-9]|[2-9]\d)?\d{2})$|^(?:0?2(\/|-|\.)29\3(?:(?:(?:1[6-9]|[2-9]\d)?(?:0[48]|[2468][048]|[13579][26])|(?:(?:16|[2468][048]|[3579][26])00))))$|^(?:(?:0?[1-9])|(?:1[0-2]))(\/|-|\.)(?:0?[1-9]|1\d|2[0-8])\4(?:(?:1[6-9]|[2-9]\d)?\d{2})$/))
	{ return 0; }

	return 1;
}

1;

Agak panjang, kan?
Ianya mudah digunakan cuma include didalam Perl script anda.

use input_lib;

if(input_validate($foo, 'required|integer')){ die("Sila masukkan integer sahaja"); }

Mungkin ada cara yang lebih baik? Jom sembang di bahagian komen.

Terdapat pengaturcara yang memandang ringan aspek sekuriti dalam perisian (kebanyakannya tak tahu, ignorance is bliss, no?) dan mengabaikannya sehinggalah suatu hari dimana perisian tersebut perlu menembusi pasaran yang lebih besar dan perlu melalui proses “penetration testing” (singkatan pen test) yang akan merungkaikan segala kelemahan yang telah diabaikan selama ini didalam pembangunan perisian tersebut.

Apabila terjadi begitu, maka bermulalah operasi menampal perisian daripada lubang-lubang sekuriti tersebut. Bagi kebanyakan input daripada pengguna dalam Perl/CGI, menggunakan “placeholder” adalah mencukupi untuk menyimpannya dengan selamat dalam pangkalan data (database) mengelakkan daripada SQL Injection. Rujuk article di perlmonks untuk penerangan lanjut, Preventing SQL injection attacks: Placeholders are enough for MySQL, Postgresql and SQLite.

Apa bendakah itu “placeholder”?
Placeholder adalah nilai yang digunakan untuk menggantikan sesuatu nilai yang lain.

Berikut adalah contoh penggunaan placeholder.

$sth = $dbh->prepare( "SELECT name WHERE city = ? AND state = ?" );
$sth->execute( $city, $state );

Dengan menggunakan placeholder, modul DBI akan secara automatik menguruskan isu-isu “quoting” (escape single/double quote, e.g. \”) didalam nilai yang dihantar kepada pangkalan data.

Kekurangan “placeholder”
Walaupun semua jenis input selamat dimasukkan kedalam database dengan menggunakan placeholder tanpa mengakibatkan SQL Injection, ia masih perlu diperiksa kesahihannya. Anda masih perlu untuk mengesahkan (validate) input yang dimasukkan samada ianya integer, numeric, alpha, alphanumeric, dsbnya.
Jika input tersebut adalah berbentuk HTML, tukarkan semua character ke dalam HTML Entities, untuk mengelakkan daripada kes-kes XSS (Cross-site Scripting). Jika tiada HTML dibenarkan, gunakan HTML::Scrubber untuk sental semua html daripada input tersebut.

Berikut adalah contoh untuk menukarkan character-character ke bentuk HTML Entity

use HTML::Entities;
sub html_to_db{
    my ($html) = @_;
	$html = encode_entities($html);
	$html =~ s/\r\n//gs;
	return $html;
}

Marilah kita sama sama belajar mempertahankan diri daripada anasir-anasir yang tak diingini apabila membangunkan perisian.

Selamat programming!

Saya kini bekerja disyarikat yang menggunakan perl sebagai pelantar (platform) pembangunan aplikasi web, jadi perkembangannya harus saya ikuti untuk mengelakkan diri daripada terperangkap didalam jerangkap (pitfalls) didalam pembangunan perisian menggunakan perl.

Sumber:

• Why Perl 5.11.0 Matters
• Perl 5.11.0 is now available

Kod dibawah agak ringkas.

use HTML::Entities ();
use CGI qw/:standard/;

$query = new CGI;

$username	= $query -> param('username');
$password	= $query -> param('password');

$sql = qq~
	SELECT somefields
	FROM user
	WHERE username = ?
	AND password = ?
~;

$ok_chars = 'a-zA-Z0-9 ,-';
$c_username = HTML::Entities::decode( $username);
$c_username =~ s/[^$ok_chars]//go;

$dbquery = $conn->prepare($sqlstatement);
$dbquery->execute("$c_username", "$password" ) or &error("SQL&Couldn't execute statement: $DBI::errstr");

Jika ada cara lain, silalah kongsi! Terima kasih.