[Commits] perl_plugin.c 1.19.2.36 1.19.2.37

[holger at claws-mail.org]

Update of /home/claws-mail/plugins/perl/src
In directory srv:/tmp/cvs-serv1254/src

Modified Files:
      Tag: gtk2
	perl_plugin.c 
Log Message:
2012-08-10 [holger]	0.9.19cvs3

	* src/perl_plugin.c
		Harden against undef values due to non-existing header fields 

Index: perl_plugin.c
===================================================================
RCS file: /home/claws-mail/plugins/perl/src/perl_plugin.c,v
retrieving revision 1.19.2.36
retrieving revision 1.19.2.37
diff -u -d -r1.19.2.36 -r1.19.2.37
--- perl_plugin.c	10 Aug 2012 22:16:47 -0000	1.19.2.36
+++ perl_plugin.c	10 Aug 2012 22:56:08 -0000	1.19.2.37
@@ -1581,6 +1581,15 @@
 "   	       'pink'     =>  3,'sky blue' =>  4,'blue' =>  5,\n"
 "    	       'green'    =>  6,'brown'    =>  7);\n"
 "# For convenience\n"
+"sub lc2_ {\n"
+"    my $arg = shift;\n"
+"    if(defined $arg) {\n"
+"        return lc $arg;\n"
+"    }\n"
+"    else {\n"
+"        return \"\";\n"
+"    }\n"
+"}\n"
 "sub to           { return \"to\";            }\n"
 "sub cc           { return \"cc\";            }\n"
 "sub from         { return \"from\";          }\n"
@@ -1599,7 +1608,7 @@
 "	init_();\n"
 "	return keys %header;\n"
 "    }\n"
-"    $key = lc $key; $key =~ s/:$//;\n"
+"    $key = lc2_ $key; $key =~ s/:$//;\n"
 "    init_() unless exists $header{$key};\n"
 "    if(exists $header{$key}) {\n"
 "	wantarray ? return @{$header{$key}} : return $header{$key}->[-1];\n"
@@ -1663,7 +1672,7 @@
 "}\n"
 "sub colorlabel {\n"
 "    my $color = shift;\n"
-"    $color = lc $color;\n"
+"    $color = lc2_ $color;\n"
 "    $color = $colors{$color} if exists $colors{$color};\n"
 "    $color = 0 if $color =~ m/\\D/;\n"
 "    return ClawsMail::C::colorlabel($color);\n"
@@ -1756,7 +1765,7 @@
 "}\n"
 "# Internals\n"
 "sub add_header_entries_ {\n"
-"    my($key, at values) = @_; $key = lc $key; $key =~ s/:$//;\n"
+"    my($key, at values) = @_; $key = lc2_ $key; $key =~ s/:$//;\n"
 "    $header{$key} = [] unless exists $header{$key};\n"
 "    push @{$header{$key}}, at values;\n"
 "}\n"
@@ -1820,8 +1829,8 @@
 "	if(not $regexp) { \n"
 "    	    return ((index(header(\"to\"),$what) != -1) or\n"
 "    		    (index(header(\"cc\"),$what) != -1)) unless $nocase;\n"
-"    	    return ((index(lc header(\"to\"),lc $what) != -1) or\n"
-"    		    (index(lc header(\"cc\"),lc $what) != -1))\n"
+"    	    return ((index(lc2_(header(\"to\")),lc2_($what)) != -1) or\n"
+"    		    (index(lc2_(header(\"cc\")),lc2_($what)) != -1))\n"
 "    	    } else {\n"
 "    		return ((header(\"to\") =~ m/$what/) or\n"
 "    			(header(\"cc\") =~ m/$what/)) unless $nocase;\n"
@@ -1832,7 +1841,7 @@
 "	my $mybody = body(); $mybody =~ s/\\s+/ /g;\n"
 "    	if(not $regexp) {\n"
 "    	    return (index($mybody,$what) != -1) unless $nocase;\n"
-"    	    return (index(lc $mybody,lc $what) != -1);\n"
+"    	    return (index(lc2_($mybody),lc2_($what)) != -1);\n"
 "    	} else {\n"
 "    	    return ($body =~ m/$what/) unless $nocase;\n"
 "    	    return ($body =~ m/$what/i);\n"
@@ -1842,7 +1851,7 @@
 "    	if(not $regexp) {\n"
 "    	    $myheader =~ s/\\s+/ /g;\n"
 "    	    return (index($myheader,$what) != -1) unless $nocase;\n"
-"    	    return (index(lc $myheader,lc $what) != -1);\n"
+"    	    return (index(lc2_($myheader),lc2_($what)) != -1);\n"
 "    	} else {\n"
 "    	    return ($myheader =~ m/$what/) unless $nocase;\n"
 "    	    return ($myheader =~ m/$what/i);\n"
@@ -1853,18 +1862,18 @@
 "    	if(not $regexp) {\n"
 "    	    $message =~ s/\\s+/ /g;\n"
 "    	    return (index($message,$what) != -1) unless $nocase;\n"
-"    	    return (index(lc $message,lc $what) != -1);\n"
+"    	    return (index(lc2_($message),lc2_($what)) != -1);\n"
 "    	} else {\n"
 "    	    return ($message =~ m/$what/) unless $nocase;\n"
 "    	    return ($message =~ m/$what/i);\n"
 "    	}\n"
 "    } else {\n"
-"	$where = lc $where;\n"
-"	my $myheader = header(lc $where); $myheader ||= \"\";\n"
+"	$where = lc2_ $where;\n"
+"	my $myheader = header(lc2_ $where); $myheader ||= \"\";\n"
 "	return 0 unless $myheader;\n"
 "    	if(not $regexp) {		\n"
 "    	    return (index(header($where),$what) != -1) unless $nocase;\n"
-"    	    return (index(lc header($where),lc $what) != -1);\n"
+"    	    return (index(lc2_(header($where)),lc2_($what)) != -1);\n"
 "    	} else {\n"
 "    	    return (header($where) =~ m/$what/) unless $nocase;\n"
 "    	    return (header($where) =~ m/$what/i);\n"
@@ -1938,7 +1947,7 @@
 "sub move { ClawsMail::C::move(@_); stop(1);}\n"
 "sub dele { ClawsMail::C::delete(); stop(1);}\n"
 "sub color {\n"
-"    ($color) = @_;$color = lc $color;\n"
+"    ($color) = @_;$color = lc2_ $color;\n"
 "    $color = $colors{$color} if exists $colors{$color};\n"
 "    $color = 0 if $color =~ m/\\D/;\n"
 "    ClawsMail::C::color($color);\n"