XREAの共用SSLアクセスでCGI::Sessionの-ip_matchを機能させる

XREAの共用SSLサーバを使ってPerlのCGIを使うとして、これってプロキシになっていて、スクリプト側からすると、非SSL通信になっていますので、$ENV{'REMOTE_ADDR'}は、XREAのサーバのIPアドレスになってしまいます。

CGI::Sessionの-ip_matchに影響が出るので、パッチします。

前提条件として、使っているXREAのCGI::Sessionのバージョンが3.95である事を確認。sshで入って、/usr/bin/less /usr/local/lib/perl5/site_perl/5.8.4/CGI/Session.pm でどうぞ。

バージョン上がるとpatchあてずdieします。4.0系になるとパッチを書き換えないといけないので注意。

#!/usr/bin/perl
use strict;
use warnings;
use CGI::Session qw(-ip_match);
cgi_session_fixup();


#メインルーチンここにかけ

exit;


# CGI::SessionをXREAの共通SSLに対応させるパッチ
sub cgi_session_fixup {
  # このpatchは、XREAにインストール済みのCGI::Session 3.95のみ対応
  die 'CGI::Session ga 3.95 yori new!'
    if CGI::Session->VERSION > 3.95;
  package CGI::Session;
  no warnings 'redefine';
  
  *__remote_addr = sub {
    # XREA SSLアクセス対策
    # XREAのhttps://ss1.xrea.com 経由でアクセスすると、
    # 内部的には XREAの内部サーバからアクセスされていることに
    # なるので、CGI::Session の -ip_matchの動きに影響が出ます。
    # XREAの内部サーバ経由時には、環境変数HTTP_X_FORWARDED_FOR
    # を入れることにします。
    if($ENV{'REMOTE_ADDR'} =~ /^192\.168\./ ||
       $ENV{'REMOTE_ADDR'} =~ /^219\.101\.229\./) {
      return $ENV{HTTP_X_FORWARDED_FOR};
    } else {
      return $ENV{REMOTE_ADDR};
    }
  };
  *_ip_matches = sub {
      return ( $_[0]->{_DATA}->{_SESSION_REMOTE_ADDR} eq __remote_addr() );
  };
  # _init_new_session() - initializes a new session
  *_init_new_session = sub {
      my $self = shift;
      
      my $currtime = time();
      $self->{_DATA} = {
          _SESSION_ID => $self->generate_id($self->{_OPTIONS}),
          _SESSION_CTIME => $currtime,
          _SESSION_ATIME => $currtime,
          _SESSION_ETIME => undef,
          _SESSION_REMOTE_ADDR => __remote_addr() || undef,
          _SESSION_EXPIRE_LIST => { },            
      };
      
      # to Chris Dolan's request:
          # I'm not sure if this information should be serialized (placed under _DATA),
          # but I don't see any desperate need for it. So let it be part of the object
          $self->{_IS_NEW} = 1;
      
      $self->{_STATUS} = MODIFIED;
      
      return 1;
  };
return 1;
}

このエントリを書くにあたって、

http://sb.xrea.com/showthread.php?&threadid=6646
http://sb.xrea.com/showthread.php?t=8531
404 Blog Not Found:perl - パッチなしでパッチする

を参考にしたよ。