PARSE command now checks factoidAccess. UNIDENTIFY added. OPME added. DECLASSIFY...
authorpdbogen <pdbogen@088b83a4-0077-4247-935c-42ec02c2848b>
Fri, 25 Jan 2008 19:18:45 +0000 (19:18 +0000)
committerpdbogen <pdbogen@088b83a4-0077-4247-935c-42ec02c2848b>
Fri, 25 Jan 2008 19:18:45 +0000 (19:18 +0000)
git-svn-id: https://www.cernu.us/~pdbogen/svn/destult2@34 088b83a4-0077-4247-935c-42ec02c2848b

cmdaccess.yaml
commands.yaml
irc.pl

index a7d80d8..0125184 100644 (file)
@@ -6,11 +6,13 @@ CMDACCESS: 2
 CONFIG: 2
 DEFINE: 1
 DIE: 2
+FLUSHURLS: 1
 IGNORE: 2
 JOIN: 1
+OPME: 1
 PART: 1
 REGISTER: 0
+RELOADCOMMANDS: 1
 REPLACE: 1
 SIEVE: 1
 TRANSLATE: 0
-FLUSHURLS: 1
index c412e4f..ddc8ef9 100644 (file)
@@ -60,11 +60,35 @@ CLASSIFY: |-
        $heap->{ 'cmdaccess' }->{ uc( $cmd ) } = $level;
         DumpFile( "cmdaccess.yaml", $heap->{ 'cmdaccess' } );
         $kernel->post( $src, $replypath, "Set.", $dest );
+    } elsif( exists( $heap->{ 'db' }->{ uc( $cmd ) } ) ) {
+      $heap->{ 'factoidAccess' } = {} unless exists $heap->{ 'factoidAccess' };
+      $heap->{ 'factoidAccess' }->{ uc( $cmd ) } = $level;
+      DumpFile( 'factoidAccess.yaml', $heap->{ 'factoidAccess' } );
+      $kernel->post( $src, $replypath, "Set.", $dest );
     } else {
        $kernel->post( $src, $replypath, "'$cmd' not found.", $dest );
     }
   }
 
+DECLASSIFY: |-
+  sub {
+    my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
+    my %lists = (
+      'cmdaccess' => 'command',
+      'factoidAccess' => 'factoid',
+    );
+    my $found = 0;
+    for my $list (keys %lists) {
+      if( exists( $heap->{ $list } ) && exists( $heap->{ $list }->{ uc( $what ) } ) ) {
+        delete( $heap->{ $list }->{ uc( $what ) } );
+        $kernel->post( $src, $replypath, "'$what' removed from ".$lists{ $list }." access list.", $dest );
+        $found = 1;
+      }
+    }
+    if( !$found ) {
+      $kernel->post( $src, $replypath, "'$what' not found in any access lists.", $dest );
+    }
+  }
 ACCESSLIST: |-
   sub {
     my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
@@ -131,6 +155,43 @@ SCTITLE: |-
     }
   }
 
+RELOADCOMMANDS: |-
+  sub {
+    my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
+    if( -e "commands.yaml" ) {
+      my %source = %{ LoadFile( "commands.yaml" ) };
+      for my $key ( keys %source ) {
+        print( "CORE: Parsing $key..." );
+        $heap->{ 'commands' }->{ $key } = eval( $source{ $key } );
+        if( $@ ) {
+          print( "FAILED: $@\n\n" );
+          delete $heap->{ 'commands' }->{ $key };
+        } else {
+          print( "Done.\n" );
+        }
+      }
+      $kernel->post( $src, $replypath, "Commands reloaded.", $dest );
+    } else {
+      $kernel->post( $src, $replypath, "No commands file found.", $dest );
+    }
+  }
+
+OPME: |-
+  sub {
+    my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
+    $kernel->post( $src, "do_mode", $dest, "+o $who" );
+  }
+
+UNIDENTIFY: |-
+  sub {
+    my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
+    if( exists( $heap->{ 'identified' } ) && exists( $heap->{ 'identified' }->{ $src.uc( $who ) } ) ) {
+      delete $heap->{ 'identified' }->{ $src.uc( $who ) };
+      $kernel->post( $src, $replypath, "$who: Identification cancelled.", $dest );
+    } else {
+      $kernel->post( $src, $replypath, "$who: You are not identified.", $dest );
+    }
+  }
 IDENTIFY: |-
   sub {
     use Digest::MD5 qw( md5_hex );
@@ -266,9 +327,22 @@ APPEND: |-
 
 PARSE: |-
   sub {
+    use YAML qw(LoadFile DumpFile);
     my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
     print( "PARSE: $who for $what from $src to $dest via $replypath\n" );
     print( "PARSE: $what is ".$heap->{ 'db' }->{ uc( $what ) }."\n" );
+
+    if( !exists( $heap->{ 'factoidAccess' } ) && -e 'factoidAccess.yaml' ) {
+       $heap->{ 'factoidAccess' } = LoadFile( 'factoidAccess.yaml' );
+    }
+
+    if( exists( $heap->{ 'factoidAccess' }->{ uc( $what ) } ) &&
+      ( !exists( $heap->{ 'identified' }->{ $src.uc( $who ) } ) ||
+        accessLevel( $kernel, $heap, uc( $who ), $src ) < $heap->{ 'factoidAccess' }->{ uc( $what ) } ) ) {
+      $kernel->post( $src, $replypath, "$who: An access level of ".$heap->{ 'factoidAccess' }->{ uc( $what ) }." is required for the factoid '$what'", $dest );
+      return;
+    }
+
     my( $response, $author ) = split( / -- /, $heap->{ 'db' }->{ uc( $what ) } );
     if( $author ) {
        $author = " -- ".$author;
diff --git a/irc.pl b/irc.pl
index 7283010..3f00206 100644 (file)
--- a/irc.pl
+++ b/irc.pl
@@ -250,7 +250,9 @@ sub on_quit {
 
 sub do_mode {
        my( $kernel, $heap, $channel, $mode ) = @_[ KERNEL, HEAP, ARG0, ARG1 ];
-       $kernel->post( $heap->{ 'ircobject' }->session_id(), "mode", $channel, $mode );
+       my( $modeType, $who ) = split( ' ', $mode, 2 );
+       print( "IRC: $channel $modeType $who\n" );
+       $kernel->post( $heap->{ 'ircobject' }->session_id(), "mode", $channel, $modeType, $who );
 }
 
 return 1;