1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
# -*- cperl -*-
# -----------------------------------------------------------------------------
# $Id: RawLog.pm 11365 2008-05-10 14:58:28Z topia $
# -----------------------------------------------------------------------------
# copyright (C) 2003 Topia <topia@clovery.jp>. all rights reserved.
package Debug::RawLog;
use strict;
use warnings;
use base qw(Module);
use Module::Use qw(Tools::DateConvert);
use Tools::DateConvert;
use Mask;
use Multicast;
sub message_io_hook {
my ($this,$message,$io,$type) = @_;
my $prefix = 'RAWLOG: ';
my $conf_entry = 'enable-';
$prefix .= do {
if ($type eq 'in') {
'<<';
} elsif ($type eq 'out') {
'>>';
} else {
'--';
}
};
$prefix .= do {
if ($io->server_p()) {
'SERVER(' . $io->network_name() . ') ';
} elsif ($io->client_p()) {
'CLIENT(' . ($io->option('logname') || $io->fullname()) . ') ';
} else {
'------ ';
}
};
$conf_entry .= do {
if ($io->server_p()) {
'server'
} elsif ($io->client_p()) {
'client';
}
};
$conf_entry .= '-' . $type;
# break with last
while (1) {
last if (($message->command =~ /^P[IO]NG$/) &&
$this->config->ignore_ping);
last unless ($this->config->get($conf_entry));
my $msg = $message->clone;
if ($this->config->resolve_numeric && $message->command =~ /^\d{3}$/) {
$msg->command(
(NumericReply::fetch_name($message->command)||'undef').
'('.$message->command.')');
}
::printmsg($prefix . $msg->serialize());
last;
}
return $message;
}
1;
=pod
info: 標準出力にクライアントやサーバとの通信をダンプする。
default: off
# 0 または省略で表示しない。 1 で表示する。
# クライアントオプションの logname によって、ダンプに使う名前を指定できます。
# サーバからの入力
enable-server-in: 1
# サーバへの出力
enable-server-out: 1
# クライアントからの入力
enable-client-in: 0
# クライアントへの出力
enable-client-out: 0
# PING/PONG を無視する
ignore-ping: 1
# NumericReply の名前を解決して表示する(ちゃんとした dump では無くなります)
resolve-numeric: 1
=cut
|
