Changeset 12950

Timestamp:

06/01/08 00:41:29 (5 years ago)

Author:

topia

Message:

* Merging r12849 through r12948 from trunk.

Location:

lang/perl/tiarra/branches/module-reload

Files:

• README.txt (copied) (copied from lang/perl/tiarra/trunk/README.txt)
• all.conf (modified) (5 diffs)
• doc/auto-reply-comparison.txt (copied) (copied from lang/perl/tiarra/trunk/doc/auto-reply-comparison.txt)
• doc/module-reload.txt (modified) (2 diffs)
• doc/module/Auto.html (modified) (5 diffs)
• main/Tiarra/Resolver.pm (modified) (1 diff)
• make-password.bat (copied) (copied from lang/perl/tiarra/trunk/make-password.bat)
• mini.conf (copied) (copied from lang/perl/tiarra/trunk/mini.conf)
• module/Auto/Reply.pm (modified) (5 diffs)
• module/System/WebClient.pm (modified) (10 diffs)
• module/Tools/Reload.pm (copied) (copied from lang/perl/tiarra/trunk/module/Tools/Reload.pm)
• run-tiarra.bat (copied) (copied from lang/perl/tiarra/trunk/run-tiarra.bat)

lang/perl/tiarra/branches/module-reload/all.conf

@@ -835 +835 @@
 
     # 機能:
-    # - 通常応答
-    # - 登録数確認(count-query)
-    # - 反応確認(request)
-    # - 反応追加(add)
-    # - 反応削除(remove)
+    # - 通常応答(mask)
+    # - 登録数確認(count-query/mask)
+    # - 反応確認(request/modifier)
+    # - 反応追加(add/modifier)
+    # - 反応削除(remove/modifier)
     # 通常応答以外は設定を省略することで機能を無効にできます。
 
@@ -868 +868 @@
     # plum: mask: *!*@*
 
-    # このブロックが発言に反応する確率を指定します。
+    # マッチした１つの反応マスクが実際に発言に反応する確率を指定します。
     # 百分率です。省略された場合は100と見做されます。
     rate: 100
-
-
-    # 反応の確認を行うためのキーワードを指定します。
-    # 実際の指定方法は、「<requestで指定したキーワード> <チェックしたい発言>」です。
-    # 省略するとこの機能は無効になります。
-    # 指定したときだけこの機能が有効になります。
-    request: 反応チェック
-
-    # request に反応するときのフォーマットを指定します。
-    # #(key) がキーワード、 #(message) が発言に置換されます。
-    # request を指定したときのみ必要。
-    reply-format: 「#(key)」という発言に「#(message)」と反応します。
-
-    # request に反応する最大個数(ブロックの数)を指定します。
-    # あまり大きな値を指定すると、アタックが可能になったり、ログが流れて邪魔なので注意してください。
-    # 通常の反応には関与しません。また、応答の行数ではありません。
-    max-reply: 5
 
     # メッセージの登録数を返答するキーワードを指定します。
     # 省略するとこの機能は無効になります。
     # 指定したときだけこの機能が有効になります。
+    # mask で許可された人(通常応答を返す人)が使えます。
     count-query: 反応登録数
 
@@ -904 +888 @@
     # 省略するとこの機能は無効になります。
     # 指定したときだけこの機能が有効になります。
+    # modifier で許可された人だけ使えます。
     #add: 反応追加
 
@@ -914 +899 @@
     # 省略するとこの機能は無効になります。
     # 指定したときだけこの機能が有効になります。
+    # modifier で許可された人だけ使えます。
     #remove: 反応削除
 
@@ -920 +906 @@
     removed-format: #(name|nick.now): #(key) #(message;に対する反応 %s|;) を #(count) 件削除しました。
 
-    # addとremoveを許可する人。省略された場合は「* *!*@*」と見做します。
+    # 反応の確認を行うためのキーワードを指定します。
+    # 通常応答と違って, multivalue-limit の制限を受けずに全てのマッチした応答を返します。
+    # 実際の指定方法は、「<requestで指定したキーワード> <チェックしたい発言>」です。
+    # 省略するとこの機能は無効になります。
+    # 指定したときだけこの機能が有効になります。
+    # modifier で許可された人だけ使えます。
+    request: 反応チェック
+
+    # request に反応するときのフォーマットを指定します。
+    # #(key) がキーワード、 #(message) が発言に置換されます。
+    # request を指定したときのみ必要。
+    reply-format: 「#(key)」という発言に「#(message)」と反応します。
+
+    # request に反応する最大個数(反応マスクの数)を指定します。
+    # (１つの反応マスクに対応するメッセージの数は制限されません。)
+    # あまり大きな値を指定すると、アタックが可能になったり、ログが流れて邪魔なので注意してください。
+    # 通常の反応には関与しません。また、応答の行数ではありません。
+    max-reply: 5
+
+    # 編集系コマンド, add とremove と request を許可する人。
+    # 省略された場合は「* *!*@*」(全員許可)と見做します。
     modifier: * *!*@*
 

lang/perl/tiarra/branches/module-reload/doc/module-reload.txt

@@ -59 +59 @@
 ---
 
+BBSを用いる.
+main いじらなくていいのでお手軽.
+
+とりあえず Tools::Rreload をつくってみた.
+動作確認してないからうごくかはわかんない.
+
+ my $my_key = __PACKAGE__;
+
+ # At destruct().
+ Tools::Reload->store($my_key, $value);
+
+ # At new().
+ my $value = Tools::Reload->fetch($my_key);
+ if( !$value )
+ {
+   # new loading.
+ }else
+ {
+   # reloading.
+ }
+
+案4
+---
+
 思いついたらふやす.
 
@@ -81 +105 @@
   module_destruct を Timer, Hook, ExternalSocket, Tiarra::Socket, それから
   Tiarra::WrapMainLoop に実装した. あと何かありましたっけ.
+
+[EOF]

lang/perl/tiarra/branches/module-reload/doc/module/Auto.html

@@ -764 +764 @@
 <p class="comment">
 機能:<br />
-- 通常応答<br />
-- 登録数確認(count-query)<br />
-- 反応確認(request)<br />
-- 反応追加(add)<br />
-- 反応削除(remove)<br />
+- 通常応答(mask)<br />
+- 登録数確認(count-query/mask)<br />
+- 反応確認(request/modifier)<br />
+- 反応追加(add/modifier)<br />
+- 反応削除(remove/modifier)<br />
 通常応答以外は設定を省略することで機能を無効にできます。<br />
 </p>
@@ -806 +806 @@
 </p>
 <p class="comment">
-このブロックが発言に反応する確率を指定します。<br />
+マッチした１つの反応マスクが実際に発言に反応する確率を指定します。<br />
 百分率です。省略された場合は100と見做されます。<br />
 </p>
 <div class="element"><span class="key">rate</span>:<span class="value">100</span></div>
-<p class="comment">
-反応の確認を行うためのキーワードを指定します。<br />
-実際の指定方法は、「&lt;requestで指定したキーワード&gt; &lt;チェックしたい発言&gt;」です。<br />
-省略するとこの機能は無効になります。<br />
-指定したときだけこの機能が有効になります。<br />
-</p>
-<div class="element"><span class="key">request</span>:<span class="value">反応チェック</span></div>
-<p class="comment">
-request に反応するときのフォーマットを指定します。<br />
-#(key) がキーワード、 #(message) が発言に置換されます。<br />
-request を指定したときのみ必要。<br />
-</p>
-<div class="element"><span class="key">reply-format</span>:<span class="value">「#(key)」という発言に「#(message)」と反応します。</span></div>
-<p class="comment">
-request に反応する最大個数(ブロックの数)を指定します。<br />
-あまり大きな値を指定すると、アタックが可能になったり、ログが流れて邪魔なので注意してください。<br />
-通常の反応には関与しません。また、応答の行数ではありません。<br />
-</p>
-<div class="element"><span class="key">max-reply</span>:<span class="value">5</span></div>
 <p class="comment">
 メッセージの登録数を返答するキーワードを指定します。<br />
 省略するとこの機能は無効になります。<br />
 指定したときだけこの機能が有効になります。<br />
+mask で許可された人(通常応答を返す人)が使えます。<br />
 </p>
 <div class="element"><span class="key">count-query</span>:<span class="value">反応登録数</span></div>
@@ -847 +829 @@
 省略するとこの機能は無効になります。<br />
 指定したときだけこの機能が有効になります。<br />
+modifier で許可された人だけ使えます。<br />
 </p>
 <div class="element"><span class="key">add</span>:<span class="value">反応追加</span></div>
@@ -859 +842 @@
 省略するとこの機能は無効になります。<br />
 指定したときだけこの機能が有効になります。<br />
+modifier で許可された人だけ使えます。<br />
 </p>
 <div class="element"><span class="key">remove</span>:<span class="value">反応削除</span></div>
@@ -867 +851 @@
 <div class="element"><span class="key">removed-format</span>:<span class="value">#(name|nick.now): #(key) #(message;に対する反応 %s|;) を #(count) 件削除しました。</span></div>
 <p class="comment">
-addとremoveを許可する人。省略された場合は「* *!*@*」と見做します。<br />
+反応の確認を行うためのキーワードを指定します。<br />
+通常応答と違って, multivalue-limit の制限を受けずに全てのマッチした応答を返します。<br />
+実際の指定方法は、「&lt;requestで指定したキーワード&gt; &lt;チェックしたい発言&gt;」です。<br />
+省略するとこの機能は無効になります。<br />
+指定したときだけこの機能が有効になります。<br />
+modifier で許可された人だけ使えます。<br />
+</p>
+<div class="element"><span class="key">request</span>:<span class="value">反応チェック</span></div>
+<p class="comment">
+request に反応するときのフォーマットを指定します。<br />
+#(key) がキーワード、 #(message) が発言に置換されます。<br />
+request を指定したときのみ必要。<br />
+</p>
+<div class="element"><span class="key">reply-format</span>:<span class="value">「#(key)」という発言に「#(message)」と反応します。</span></div>
+<p class="comment">
+request に反応する最大個数(反応マスクの数)を指定します。<br />
+(１つの反応マスクに対応するメッセージの数は制限されません。)<br />
+あまり大きな値を指定すると、アタックが可能になったり、ログが流れて邪魔なので注意してください。<br />
+通常の反応には関与しません。また、応答の行数ではありません。<br />
+</p>
+<div class="element"><span class="key">max-reply</span>:<span class="value">5</span></div>
+<p class="comment">
+編集系コマンド, add とremove と request を許可する人。<br />
+省略された場合は「* *!*@*」(全員許可)と見做します。<br />
 </p>
 <div class="element"><span class="key">modifier</span>:<span class="value">* *!*@*</span></div>

lang/perl/tiarra/branches/module-reload/main/Tiarra/Resolver.pm

@@ -66 +66 @@
 our $use_threads_state_checking;
 BEGIN {
-    $use_threads = Tiarra::OptionalModules->threads;
+    $use_threads = !$^C && Tiarra::OptionalModules->threads;
     if ($use_threads) {
         require threads;

lang/perl/tiarra/branches/module-reload/module/Auto/Reply.pm

@@ -256 +256 @@
 
   # 機能:
-  # - 通常応答
-  # - 登録数確認(count-query)
-  # - 反応確認(request)
-  # - 反応追加(add)
-  # - 反応削除(remove)
+  # - 通常応答(mask)
+  # - 登録数確認(count-query/mask)
+  # - 反応確認(request/modifier)
+  # - 反応追加(add/modifier)
+  # - 反応削除(remove/modifier)
   # 通常応答以外は設定を省略することで機能を無効にできます。
 
@@ -289 +289 @@
   # plum: mask: *!*@*
 
-  # このブロックが発言に反応する確率を指定します。
+  # マッチした１つの反応マスクが実際に発言に反応する確率を指定します。
   # 百分率です。省略された場合は100と見做されます。
   rate: 100
-
-
-  # 反応の確認を行うためのキーワードを指定します。
-  # 実際の指定方法は、「<requestで指定したキーワード> <チェックしたい発言>」です。
-  # 省略するとこの機能は無効になります。
-  # 指定したときだけこの機能が有効になります。
-  request: 反応チェック
-
-  # request に反応するときのフォーマットを指定します。
-  # #(key) がキーワード、 #(message) が発言に置換されます。
-  # request を指定したときのみ必要。
-  reply-format: 「#(key)」という発言に「#(message)」と反応します。
-
-  # request に反応する最大個数(ブロックの数)を指定します。
-  # あまり大きな値を指定すると、アタックが可能になったり、ログが流れて邪魔なので注意してください。
-  # 通常の反応には関与しません。また、応答の行数ではありません。
-  max-reply: 5
 
   # メッセージの登録数を返答するキーワードを指定します。
   # 省略するとこの機能は無効になります。
   # 指定したときだけこの機能が有効になります。
+  # mask で許可された人(通常応答を返す人)が使えます。
   count-query: 反応登録数
 
@@ -325 +309 @@
   # 省略するとこの機能は無効になります。
   # 指定したときだけこの機能が有効になります。
+  # modifier で許可された人だけ使えます。
   -add: 反応追加
 
@@ -335 +320 @@
   # 省略するとこの機能は無効になります。
   # 指定したときだけこの機能が有効になります。
+  # modifier で許可された人だけ使えます。
   -remove: 反応削除
 
@@ -341 +327 @@
   removed-format: #(name|nick.now): #(key) #(message;に対する反応 %s|;) を #(count) 件削除しました。
 
-  # addとremoveを許可する人。省略された場合は「* *!*@*」と見做します。
+  # 反応の確認を行うためのキーワードを指定します。
+  # 通常応答と違って, multivalue-limit の制限を受けずに全てのマッチした応答を返します。
+  # 実際の指定方法は、「<requestで指定したキーワード> <チェックしたい発言>」です。
+  # 省略するとこの機能は無効になります。
+  # 指定したときだけこの機能が有効になります。
+  # modifier で許可された人だけ使えます。
+  request: 反応チェック
+
+  # request に反応するときのフォーマットを指定します。
+  # #(key) がキーワード、 #(message) が発言に置換されます。
+  # request を指定したときのみ必要。
+  reply-format: 「#(key)」という発言に「#(message)」と反応します。
+
+  # request に反応する最大個数(反応マスクの数)を指定します。
+  # (１つの反応マスクに対応するメッセージの数は制限されません。)
+  # あまり大きな値を指定すると、アタックが可能になったり、ログが流れて邪魔なので注意してください。
+  # 通常の反応には関与しません。また、応答の行数ではありません。
+  max-reply: 5
+
+  # 編集系コマンド, add とremove と request を許可する人。
+  # 省略された場合は「* *!*@*」(全員許可)と見做します。
   modifier: * *!*@*
 

lang/perl/tiarra/branches/module-reload/module/System/WebClient.pm

@@ -24 +24 @@
 use Scalar::Util qw(weaken);
 
-our $VERSION = '0.02';
+our $VERSION = '0.03';
 
 our $DEBUG = 0;
@@ -470 +470 @@
   }
 
+  $DEBUG and $this->_debug("$peer: check auth ...");
   my $accepted = $this->auth($conflist, $req);
   if( @$accepted )
@@ -535 +536 @@
   foreach my $conf (@$conflist)
   {
+    $DEBUG and $this->_debug("$req->{peer}: check auth for $conf->{name}");
     my $authlist = $conf->{auth} or next;
     foreach my $auth (@$authlist)
     {
-      $auth or next;
+      if( !$auth )
+      {
+        $DEBUG and ::printmsg("$req->{peer}: - skip: empty value");
+      }
       my @param = split(' ', $auth) or next;
       $param[0] =~ /^:/ or unshift(@param, ':basic');
@@ -544 +549 @@
       if( !$sub )
       {
+        $DEBUG and ::printmsg("$req->{peer}: - skip: unsupported: $param[0]");
         next;
       }
@@ -549 +555 @@
       if( $ok )
       {
+        $DEBUG and $this->_debug("$req->{peer}: - $conf->{name} accepted ($param[0])");
         push(@accepts, $conf);
       }elsif( defined($ok) )
       {
+        $DEBUG and $this->_debug("$req->{peer}: auth denied by $conf->{name}");
         return undef;
       }
@@ -566 +574 @@
 
   my $line = $req->{Header}{Authorization};
-  $line or return;
+  if( !$line )
+  {
+    $DEBUG and ::printmsg("$req->{peer}: no Authorization: header");
+    return;
+  }
 
   my ($type, $val) = split(' ', $line, 2);
-  $type eq 'Basic' or return;
+  if( $type ne 'Basic' )
+  {
+    $DEBUG and ::printmsg("$req->{peer}: not Basic Authorization (got $type)");
+    return;
+  }
 
   require MIME::Base64;
@@ -587 +603 @@
     return;
   }
+  $DEBUG and ::printmsg("$req->{peer}: accept user $param->[0] pass $param->[2] with '$user' '$pass'");
   1;
 }
@@ -920 +937 @@
 # パスワードの比較検証.
 # "{MD5}xxx" (MD5)
+# "{SMD5}xxx" (Salted MD5, hex(md5(pass+salt)+salt)
 # "{B}xxx"   (BASE64)
 # "{RAW}xxx" (生パスワード)
+# "{CRYPT}xxx" (cryptパスワード)
 # "xxx"      (生パスワード)
 #
@@ -951 +970 @@
     }
     my $cmp = Digest::MD5::md5_hex($plain);
-    return $enc eq $cmp;
+    return $cmp eq lc($enc);
+  }elsif( $type =~ /^(SMD5)\z/ )
+  {
+    eval { require Digest::MD5; };
+    if( $@ )
+    {
+      die "no Digest::MD5";
+    }
+    my $enc_hex  = substr($enc, 0, 32);
+    my $enc_salt = pack("H*",substr($enc, 32));
+    my $cmp = Digest::MD5::md5_hex($plain.$enc_salt);
+    return $cmp eq lc($enc_hex);
   }elsif( $type =~ /^(RAW)\z/ )
   {
     return $enc eq $plain;
+  }elsif( $type =~ /^(CRYPT)\z/ )
+  {
+    my $cmp = crypt($plain,substr($enc,0,2));
+    if( length($plain) > 8 )
+    {
+      my $cmp2 = crypt(substr($plain, 0, 8),substr($enc,0,2));
+      if( $cmp eq $cmp2 )
+      {
+        die "CRYPT supports upto 8 bytes";
+        return;
+      }
+    }
+    return $cmp eq $enc;
   }else
   {
@@ -1951 +1994 @@
   # auth: :softbank <UID>
   # auth: :au <SUBNO>
-  # <pass> には {MD5}xxxx や {B}xxx を利用可能.
+  # 各値(<pass>等)には {MD5}xxxx や {B}xxx や {CRYPT}xxx を利用可能.
   # そのままべた書きも出来るけれど.
   auth: :basic user pass