#!/usr/local/bin/perl -w

# $Id: http-client-auth-digest.pl,v 1.2 2005/02/19 16:01:53 68user Exp $
#
# Digest 認証 手抜きクライアント。Digest::MD5 モジュール必須。
#
#      written by 68user  http://X68000.q-e-d.net/~68user/

use strict;
use Socket;
use Digest::MD5 qw(md5_hex);

my $host     = 'X68000.q-e-d.net';
my $uri      = '/~68user/net/sample/http-auth-digest/secret.html';
my $username = 'hoge';    # ユーザ名
my $passwd   = 'fuga';    # パスワード
my $method   = "GET";

my $connect_host = $host;
my $port = getservbyname('http', 'tcp') || 80;
my $iaddr = inet_aton($connect_host) || die "$connect_host は存在しないホストです。\n";
my $sock_addr = pack_sockaddr_in($port, $iaddr);

socket(SOCKET, PF_INET, SOCK_STREAM, 0) || die "ソケット を生成できません。\n";
connect(SOCKET, $sock_addr) || die "$connect_host の ポート $port に接続できません。\n";
select(SOCKET); $|=1; select(STDOUT);

my $request = '';
$request .= "$method $uri HTTP/1.0\r\n";
$request .= "Host: $host\r\n";
$request .= "\r\n";

print "--- 1st requst ---\n$request---\n";
print SOCKET $request;

my %auth_info;
while (<SOCKET>){
    print "1st response: $_";
    if ( m/^WWW-Authenticate: Digest (.*)/i ){
	# カンマで分割 (手抜き)
        foreach (split(",",$1)){
            s/^\s*//;           # 先頭の空白を削る
            s/\s*$//;           # 末尾の空白を削る
            my ($key, $value) = m/(.*?)=(.*)/;
            $value =~ s/^\"//;  # 先頭のダブルクォートを削る (手抜き)
            $value =~ s/\"$//;  # 末尾のダブルクォートを削る (手抜き)
            print "  [$key]=[$value]\n";
            $auth_info{$key}=$value;
        }
    }
}
close(SOCKET);

# response 生成
my $nc       = '00000001';         # 決め打ち
my $cnonce   = 'e79e26e0d17c978d'; # ランダムな文字列にすべきだが、ここでは決め打ち

my $a1 = "$username:$auth_info{realm}:$passwd";
my $h_a1 = md5_hex($a1);
my $a2 = "$method:$uri";
my $h_a2 = md5_hex($a2);
my $response="$h_a1:$auth_info{nonce}:$nc:$cnonce:$auth_info{qop}:$h_a2";
my $h_response = md5_hex($response);

print "a1=[$a1]\n";
print "h_a1=[$h_a1]\n";
print "a2=[$a2]\n";
print "h_a2=[$h_a2]\n";
print "response=[$response]\n";
print "h_response=[$h_response]\n";

# 2回目の接続

socket(SOCKET, PF_INET, SOCK_STREAM, 0) || die "ソケット を生成できません。\n";
connect(SOCKET, $sock_addr) || die "$connect_host の ポート $port に接続できません。\n";
select(SOCKET); $|=1; select(STDOUT);

$request = '';
$request .= "$method $uri HTTP/1.0\r\n";
$request .= "Host: $host\r\n";
$request .= qq(Authorization: Digest username="$username",);
$request .= qq(  realm="$auth_info{realm}",);
$request .= qq(  nonce="$auth_info{nonce}",);
$request .= qq(  uri="$uri",);
$request .= qq(  algorithm=$auth_info{algorithm},);
$request .= qq(  response="$h_response",);
$request .= qq(  qop=auth, nc=$nc,);
$request .= qq(  cnonce="$cnonce"\r\n);
$request .= "\r\n";

print "\n--- 2nd requst ---\n$request---\n";
print SOCKET $request;

while (<SOCKET>){
    print "2nd response: $_";
}
close(SOCKET);