mala mala

## moose_delegate_to_method.pl
#!/usr/bin/perl

# 犬か猫かランダムに選択してワンとかニャーとか言わせたいときどうするか
# http://twitter.com/bulkneets/status/24724786124

use strict;

package Cat;
sub say { warn "Nya-" }
sub say2 { warn "Mya-" }

## twitter-text-parser.pl
use Data::Dumper;
my @r;

my $text = q{@hoge http://example.com/#@hoge/ aaa #hash aaa @hogehoge aaa http://example.com/};
my $re = qr{(http://[A-Za-z0-9_\-\~\.\%\?\#\@/]+(?{push @r, ["HTTP", @-,@+] })|(?:^|\s)\@[A-Za-z0-9_]+(?{push @r,["AT", @-,@+]})|(?:^|\s)#[A-Za-z0-9_]+(?{push @r,["HashTag",@-,@+]}))};

warn $text;
() = $text =~/$re/g;
warn Dumper @r;

## gist:621797
static int
constant(const char *name)
{
    errno = 0;

    if (strncmp(name, "CURLE_", 6) == 0) {
        name += 6;
        switch (*name) {
        case 'A':
            if (strEQ(name, "ABORTED_BY_CALLBACK")) return CURLE_ABORTED_BY_CALLBACK;

## gist:621948
# Cache::KyotoTycoon 0.05 compare with Cache::Memcached::Fast
# kyototycoonとmemcachedは別ホストで実行

# cpu time
Benchmark: timing 10000 iterations of get, get_memcached, get_rest, set, set_memcached, set_rest...
       get: 21 wallclock secs ( 3.08 usr +  0.80 sys =  3.88 CPU) @ 2577.32/s (n=10000)
get_memcached:  8 wallclock secs ( 0.09 usr +  0.15 sys =  0.24 CPU) @ 41666.67/s (n=10000)
  get_rest: 13 wallclock secs ( 1.96 usr +  0.87 sys =  2.83 CPU) @ 3533.57/s (n=10000)
       set: 12 wallclock secs ( 2.86 usr +  0.81 sys =  3.67 CPU) @ 2724.80/s (n=10000)
set_memcached:  6 wallclock secs ( 0.15 usr +  0.25 sys =  0.40 CPU) @ 25000.00/s (n=10000)

## Facebook返信案
>>
Hi,

We apologize, but the only way we will be able to verify ownership of this account is if you reply to this email with an attached color image of your government-issued photo identification confirming your full name and date of birth. Rest assured that we will permanently delete your ID from our servers once we have used it to verify the authenticity of your account.

Please note that we will not be able to process your request unless you send in proper identification. We apologize for any inconvenience this may cause.

Thanks,
<<

## gist:891919

      
              1 file
            
          
              0 forks
            
          
              0 comments
            
          
              0 stars
            
          
                mala
                / gist:891919
            
            
              Created
              March 29, 2011 06:59
            
          
    Facebookに3/27に送ったメールより転載
「クリックジャッキングが行われていると疑われるページ」を検知する改良を行っていると書かれていますが、URLに対するlikeで宣伝リンクをワーム的にばらまくspam行為や、ブラウザやプラグインの脆弱性を利用したマルウェアの配布に使われるのであれば、そういった対策はある程度効果があるでしょう。iframeで埋め込まれたコンテンツから、自分がどこに、どのように埋めこまれているのかを把握することはSame origin policyによって不可能ですし、リファラを隠蔽した上で埋め込む方法もいくらでも有ります。つまりそういった方法(クリックジャッキングの検出)ではlike数の不自然な増加を検出した事後の対策になりますし、私が指摘したような問題においては攻撃者が既に訪問者のFacebookアカウントを特定した後になります。必要な対策はもっと別のことです。

  
## test.html
<!DOCTYPE html>
<html version="HTML+RDFa 1.0" lang="ja">
  <head>
    <meta charset="UTF-8">
    <title>test</title>
  </head>
  <body>
  <font color="red" size="7">IE 6/7 must DIE!!</font>
  <script type="text/javascript">alert("this is html")</script>
  </body>

## jquery_patch.pl
#!perl

# perl jquery_patch.pl jquery-n.nn.min.js > jquery-n.nn.min.patched.js

$old = join "|", map quotemeta, (
 q{/^[^<]*(<(.|\s)+>)[^>]*$|^#(\w+)$/},
 q{/^[^<]*(<[\w\W]+>)[^>]*$|^#([\w-]+)$/},
 q{/^(?:[^<]*(<[\w\W]+>)[^>]*$|#([\w\-]+)$)/}
);
$new = q{/^(?:\s*(<[\w\W]+>)[^>]*$|#([\w\-]*)$)/};

## jq_quickpatch.html
<script type="text/javascript">
// http://ma.la/jquery_xss/
(function($){
	var _init = $.fn.init;
	$.fn.init = function(selector, context, rootjQuery){
		// note: only block "#<img>", "a[href=<img onerror=...>]" still work.
		if( typeof arguments[ 0 ] == "string" && /^#.*</.test( arguments[ 0 ] ) ){
			throw new Error( "selector error" );
		}
		// console.log(arguments[0]);

## gist:1071708
# FurlX::ParanoidAgent 的なやつ

my $furl = Furl->new(
    inet_aton => \&_inet_aton,
);

sub _inet_aton {
    my $addr = Net::DNS::Lite::inet_aton(@_);
    if (is_local_addr($addr)) { return }
    $addr;
	#!/usr/bin/perl

	# 犬か猫かランダムに選択してワンとかニャーとか言わせたいときどうするか
	# http://twitter.com/bulkneets/status/24724786124

	use strict;

	package Cat;
	sub say { warn "Nya-" }
	sub say2 { warn "Mya-" }
	use Data::Dumper;
	my @r;

	my $text = q{@hoge http://example.com/#@hoge/ aaa #hash aaa @hogehoge aaa http://example.com/};
	my $re = qr{(http://[A-Za-z0-9_\-\~\.\%\?\#\@/]+(?{push @r, ["HTTP", @-,@+] })\|(?:^\|\s)\@[A-Za-z0-9_]+(?{push @r,["AT", @-,@+]})\|(?:^\|\s)#[A-Za-z0-9_]+(?{push @r,["HashTag",@-,@+]}))};

	warn $text;
	() = $text =~/$re/g;
	warn Dumper @r;
	static int
	constant(const char *name)
	{
	errno = 0;

	if (strncmp(name, "CURLE_", 6) == 0) {
	name += 6;
	switch (*name) {
	case 'A':
	if (strEQ(name, "ABORTED_BY_CALLBACK")) return CURLE_ABORTED_BY_CALLBACK;
	# Cache::KyotoTycoon 0.05 compare with Cache::Memcached::Fast
	# kyototycoonとmemcachedは別ホストで実行

	# cpu time
	Benchmark: timing 10000 iterations of get, get_memcached, get_rest, set, set_memcached, set_rest...
	get: 21 wallclock secs ( 3.08 usr + 0.80 sys = 3.88 CPU) @ 2577.32/s (n=10000)
	get_memcached: 8 wallclock secs ( 0.09 usr + 0.15 sys = 0.24 CPU) @ 41666.67/s (n=10000)
	get_rest: 13 wallclock secs ( 1.96 usr + 0.87 sys = 2.83 CPU) @ 3533.57/s (n=10000)
	set: 12 wallclock secs ( 2.86 usr + 0.81 sys = 3.67 CPU) @ 2724.80/s (n=10000)
	set_memcached: 6 wallclock secs ( 0.15 usr + 0.25 sys = 0.40 CPU) @ 25000.00/s (n=10000)
	>>
	Hi,

	We apologize, but the only way we will be able to verify ownership of this account is if you reply to this email with an attached color image of your government-issued photo identification confirming your full name and date of birth. Rest assured that we will permanently delete your ID from our servers once we have used it to verify the authenticity of your account.

	Please note that we will not be able to process your request unless you send in proper identification. We apologize for any inconvenience this may cause.

	Thanks,
	<<
	<!DOCTYPE html>
	<html version="HTML+RDFa 1.0" lang="ja">
	<head>
	<meta charset="UTF-8">
	<title>test</title>
	</head>
	<body>
	<font color="red" size="7">IE 6/7 must DIE!!</font>
	<script type="text/javascript">alert("this is html")</script>
	</body>
	#!perl

	# perl jquery_patch.pl jquery-n.nn.min.js > jquery-n.nn.min.patched.js

	$old = join "\|", map quotemeta, (
	q{/^[^<](<(.\|\s)+>)[^>]$\|^#(\w+)$/},
	q{/^[^<](<[\w\W]+>)[^>]$\|^#([\w-]+)$/},
	q{/^(?:[^<](<[\w\W]+>)[^>]$\|#([\w\-]+)$)/}
	);
	$new = q{/^(?:\s(<[\w\W]+>)[^>]$\|#([\w\-]*)$)/};
	<script type="text/javascript">
	// http://ma.la/jquery_xss/
	(function($){
	var _init = $.fn.init;
	$.fn.init = function(selector, context, rootjQuery){
	// note: only block "#<img>", "a[href=<img onerror=...>]" still work.
	if( typeof arguments[ 0 ] == "string" && /^#.*</.test( arguments[ 0 ] ) ){
	throw new Error( "selector error" );
	}
	// console.log(arguments[0]);
	# FurlX::ParanoidAgent 的なやつ

	my $furl = Furl->new(
	inet_aton => \&_inet_aton,
	);

	sub _inet_aton {
	my $addr = Net::DNS::Lite::inet_aton(@_);
	if (is_local_addr($addr)) { return }
	$addr;