#!/usr/bin/perl ############################################################################## # Net::OpenID::Serverのサンプルソース (2005-05-25) # Author : makamaka[at]donzoko.net (http://www.donzoko.net) # License : same as Perl's one # See : http://www.danga.com/openid/ # : http://search.cpan.org/dist/Net-OpenID-Server/ ############################################################################## use strict; use CGI; use Net::OpenID::Server; # for ver 0.3 or better ############################################################################## my $cgi = new CGI; # args GETパラメータを取得するため、HashrefやCoderef、 # あるいはCGIやApache::Requestなどのオブジェクトを渡す # public_key 公開鍵のデータ、ファイル名、Coderefのいずれかを渡す # private_key 秘密鍵のデータ、ファイル名、Coderefのいずれかを渡す # get_user ユーザに関するオブジェクト(あるいはundef)を返すCoderefを渡す # is_identity ログインチェック用のCodrefを渡す # is_trusted 信頼チェック用のCoderefを渡す # setup_url ログイン、identity url、信頼のいずれかに失敗した場合redirectするURL # setup_map このCGIがuser_setup_urlで返したURLに相手サイトが再びリダイレクト # する際にtrust_root、return_to、post_grant、is_identityが加えられる。 # このデフォルトの名前を変更するためのhashrefを渡せる my $srv = Net::OpenID::Server->new( args => $cgi, # 他に$hashrefやApache::Requestなどでも private_key => \&get_priv_key, # ここではサブルーチンから返す例 public_key => "public_key.txt", # 普通にファイル名の例 get_user => \&get_user, is_identity => \&is_identity, is_trusted => \&is_trusted, setup_url => "http://www.example.com/cgi-bin/openid/setup.cgi", # 例 setup_map => { "post_grant" => "do_after_grant" }, # post_grantはdo_after_grantに変わる ); # あとはhandle_pageするだけ。戻り値はContent-typeとデータ。 my ($ctype, $page) = $srv->handle_page(); if($ctype eq "redirect"){ # $pageはsetup_url,setup_mapで指定した値 print $cgi->redirect( $page ); } elsif($ctype eq "setup"){ # 非Ajax版で利用される print $cgi->header(); WebApp::setup($page); # $pageはクエリーのhashref } else{ print $cgi->header(-type => $ctype); print $page; } ############################################################################## # コールバックルーチン sub get_user { # このCGIが使うであろうuserオブジェクトを返す。 my $u; # 処理 # ユーザが何者かわからないなら、undefを返すべき return $u; # or undef } sub is_identity { # 真値を返せば$uは$identity_urlに対し「ログイン中」 my ($u, $identity_url) = @_; # 処理 # 渡された$uがundefなら無条件で0を返すべき return 0; # or 1 } sub is_trusted { # 真値を返せば$is_identityにおいて、$uは$trust_rootを「信頼」している my ($u, $trust_root, $is_identity) = @_; # 処理 return 0; # or 1 } # 下記はコールバックルーチン以外にも、ファイル名や直接のデータでも可能 sub get_priv_key { # Net::OpenID::Serverが内部で使うprivate keyを返す例 my $key; local $/ = undef; open(FILE,"private_key.txt") or die $!; $key = ; close(FILE); $key; } # あなたのBlogシステムとかWikiシステムとかが # 非Ajaxクライアント用にセットアップページを出力する sub WebApp::setup { my $opt = shift; my $query; my $setup_url = 'http://www.example.com/cgi-bin/openid/setup.cgi'; for my $key (keys %$opt){ $query .= $key . '=' . $page->{$key} . '&'; } print < ファイナルフュージョン商人!

Setup

HTML } __END__