From c76ddd5dca69209162d130202e05ee8d078aa997 Mon Sep 17 00:00:00 2001 From: Mitchell Cooper Date: Tue, 5 Jul 2016 23:18:53 -0400 Subject: [PATCH] 11.09: added %jelp_outgoing_commands and %jelp_incoming_commands APIs. added JELP SASL implementation. #9. added sasl_mechanisms (SASL M) forwarding in TS6. --- INDEV | 4 + VERSION | 2 +- modules/JELP/Base.module/Base.json | 2 +- modules/JELP/Base.module/Base.pm | 56 ++- .../SASL/SASL.module/JELP.module/JELP.json | 2 +- modules/SASL/SASL.module/JELP.module/JELP.pm | 354 ++++++++++++++++++ modules/SASL/SASL.module/TS6.module/TS6.json | 2 +- modules/SASL/SASL.module/TS6.module/TS6.pm | 37 +- 8 files changed, 437 insertions(+), 22 deletions(-) diff --git a/INDEV b/INDEV index 8ab54826..9c4b8095 100644 --- a/INDEV +++ b/INDEV @@ -3219,3 +3219,7 @@ CHANGES: added support for sticky capabilities, updated SASL accordingly. added cap-notify capability and version parameter to CAP LS. cap-notify is sticky only when IRCv3.2 is used but not for IRCv3.1. + + 09. added %jelp_outgoing_commands and %jelp_incoming_commands APIs. + added JELP SASL implementation. #9. + added sasl_mechanisms (SASL M) forwarding in TS6. diff --git a/VERSION b/VERSION index 64d4423f..c9a70ebc 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -11.08 +11.09 diff --git a/modules/JELP/Base.module/Base.json b/modules/JELP/Base.module/Base.json index 82237207..45184bfe 100644 --- a/modules/JELP/Base.module/Base.json +++ b/modules/JELP/Base.module/Base.json @@ -11,5 +11,5 @@ }, "name" : "JELP::Base", "package" : "M::JELP::Base", - "version" : "13.53" + "version" : "13.63" } diff --git a/modules/JELP/Base.module/Base.pm b/modules/JELP/Base.module/Base.pm index e992d86c..dffd81de 100644 --- a/modules/JELP/Base.module/Base.pm +++ b/modules/JELP/Base.module/Base.pm @@ -22,15 +22,19 @@ my $PARAM_BAD = $message::PARAM_BAD; my $props = $Evented::Object::props; sub init { - + # register methods. $mod->register_module_method('register_jelp_command' ) or return; $mod->register_module_method('register_global_command' ) or return; $mod->register_module_method('register_outgoing_command') or return; - - # module unload event. + + # module events. $api->on('module.unload' => \&unload_module, with_eo => 1) or return; - + $api->on('module.init' => \&module_init, + name => '%jelp_outgoing_commands', + with_eo => 1 + ) or return; + return 1; } @@ -48,10 +52,10 @@ sub register_jelp_command { L("JELP command $opts{name} does not have '$what' option"); return; } - + my $command = uc $opts{name}; my $e_name = "server.jelp_message_$command"; - + # attach the event. $pool->on($e_name => \&_handle_command, priority => 0, # registration commands are 500 priority @@ -63,7 +67,7 @@ sub register_jelp_command { parameters => $opts{parameters} // $opts{params}, cb_code => $opts{code} }); - + # this callback forwards to other servers. $pool->on($e_name => \&_forward_handler, priority => 0, @@ -72,13 +76,13 @@ sub register_jelp_command { name => "jelp.$command.forward", data => { forward => $opts{forward} } ) if $opts{forward}; - + $mod->list_store_add('jelp_commands', $command); } sub register_global_command { my ($mod, $event, %opts) = @_; - + # make sure all required options are present foreach my $what (qw|name|) { next if exists $opts{$what}; @@ -86,19 +90,19 @@ sub register_global_command { L("global command $opts{name} does not have '$what' option"); return; } - + # create a handler that calls ->handle_unsafe(). $opts{code} = sub { my ($server, $msg, $user, $rest) = @_; $user->handle_unsafe("$opts{name} $rest"); }; - + # pass it on to this base's ->register_jelp_command(). return register_jelp_command($mod, $event, %opts, parameters => '-source(user) :rest(opt)' ); - + } sub register_outgoing_command { @@ -137,7 +141,7 @@ sub _handle_command { # JELP param handlers and lookup method. $msg->{source_lookup_method} = \&_lookup_source; $msg->{param_package} = __PACKAGE__; - + # figure parameters. my @params; if (my $params = $event->callback_data('parameters')) { @@ -145,11 +149,11 @@ sub _handle_command { @params = $msg->parse_params($params); return if defined $params[0] && $params[0] eq $message::PARAM_BAD; } - + # call actual callback. $event->{$props}{data}{allow_fantasy} = $event->callback_data('fantasy'); $event->callback_data('cb_code')->($server, $msg, @params); - + } sub _forward_handler { @@ -163,7 +167,7 @@ sub _forward_handler { # forward = 2 means don't do it even if THAT server is bursting. # return if $forward == 2 && $server->{is_burst}; - + $server->send_children($msg->data); } @@ -196,7 +200,7 @@ sub _param_user { # channel: match a channel name. sub _param_channel { my ($msg, $param, $params, $opts) = @_; - my $channel = $pool->lookup_channel((split ',', $param)[0]) or return $PARAM_BAD; + my $channel = $pool->lookup_channel((split ',', $param)[0]) or return $PARAM_BAD; push @$params, $channel; } @@ -218,6 +222,24 @@ sub _lookup_source { ### Module events ### ##################### +sub module_init { + my ($mod, $event) = @_; + + my %commands = $mod->get_symbol('%jelp_outgoing_commands'); + $mod->register_outgoing_command( + name => $_, + code => $commands{$_} + ) or return foreach keys %commands; + + %commands = $mod->get_symbol('%jelp_incoming_commands'); + $mod->register_jelp_command( + name => $_, + %{ $commands{$_} } + ) or return foreach keys %commands; + + return 1; +} + sub unload_module { my ($mod, $event) = @_; $pool->delete_outgoing_handler($_, 'jelp') diff --git a/modules/SASL/SASL.module/JELP.module/JELP.json b/modules/SASL/SASL.module/JELP.module/JELP.json index 40bcf79f..87727d3d 100644 --- a/modules/SASL/SASL.module/JELP.module/JELP.json +++ b/modules/SASL/SASL.module/JELP.module/JELP.json @@ -6,5 +6,5 @@ "description" : "JELP SASL implementation", "name" : "SASL::JELP", "package" : "M::SASL::JELP", - "version" : "0.1" + "version" : "0.4" } diff --git a/modules/SASL/SASL.module/JELP.module/JELP.pm b/modules/SASL/SASL.module/JELP.module/JELP.pm index 718b3e8d..a739df5a 100644 --- a/modules/SASL/SASL.module/JELP.module/JELP.pm +++ b/modules/SASL/SASL.module/JELP.module/JELP.pm @@ -20,4 +20,358 @@ use 5.010; our ($api, $mod, $pool, $me); +our %jelp_incoming_commands = ( + SASLHOST => { + # :sid SASLHOST serv_mask source_uid target_uid host ip + params => '-source(server) * * * * *', + code => \&saslhost + }, + SASLSTART => { + # :sid SASLSTART serv_mask source_uid target_uid auth_method + params => '-source(server) * * * *', + code => \&saslstart + }, + SASLDATA => { + # :sid SASLDATA serv_mask source_uid target_uid client_data + params => '-source(server) * * * *', + code => \&sasldata + }, + SASLDONE => { + # :sid SASLDONE serv_mask source_uid target_uid done_mode + params => '-source(server) * * * *', + code => \&sasldone + }, + SASLSET => { + # :sid SASLSET serv_mask target_uid nick ident cloak act_name + params => '-source(server) * * * * * *', + code => \&saslset + }, + SASLMECHS => { + # # :sid SASLDONE serv_mask source_uid target_uid mechs + params => '-source(server) * * * *', + code => \&saslmechs + } +); + +our %jelp_outgoing_commands = ( + sasl_host_info => \&out_saslhost, + sasl_initiate => \&out_saslstart, + sasl_client_data => \&out_sasldata, + sasl_done => \&out_sasldone, + sasl_conn_info => \&out_saslset, + sasl_mechanisms => \&out_saslmechs +); + +######################### +### INCOMING COMMANDS ### +######################### + +sub saslhost { + my ($server, $msg, + $source_serv, # services server + $serv_mask, # server mask + $source_uid, # source UID + $target_uid, # target UID + $host, # user hostname + $ip # user IP address + ) = @_; + + # we don't do anything with this. + return 1 if lc $serv_mask eq lc $me->name; + + #=== Forward ===# + $msg->forward_to_mask($serv_mask, sasl_client_data => @_[2..7]); + + return 1; +} + +sub saslstart { + my ($server, $msg, + $source_serv, # services server + $serv_mask, # server mask + $source_uid, # source UID + $target_uid, # target UID + $auth_method # authentication method + ) = @_; + + # we don't do anything with this. + return 1 if lc $serv_mask eq lc $me->name; + + #=== Forward ===# + $msg->forward_to_mask($serv_mask, sasl_initiate => @_[2..6]); + + return 1; +} + +sub sasldata { + my ($server, $msg, + $source_serv, # services server + $serv_mask, # server mask + $source_uid, # source UID + $target_uid, # target UID + $data # client data + ) = @_; + + #=== Forward ===# + # it has to be me. + if (lc $serv_mask ne lc $me->name) { + $msg->forward_to_mask($serv_mask, sasl_client_data => @_[2..6]); + return 1; + } + + my $conn = find_connection($target_uid) or return; + + # send AUTHENTICATE + $conn->send("AUTHENTICATE $data"); + $conn->{sasl_messages}++; + + return 1; +} + +sub sasldone { + my ($server, $msg, + $source_serv, # services server + $serv_mask, # server mask + $source_uid, # source UID + $target_uid, # target UID + $done_mode # reason for being done + ) = @_; + + #=== Forward ===# + # it has to be me. + if (lc $serv_mask ne lc $me->name) { + $msg->forward_to_mask($serv_mask, sasl_done => @_[2..6]); + return 1; + } + + my $conn = find_connection($target_uid) or return; + + # F - authentication failure. + if ($done_mode eq 'F') { + $conn->numeric('ERR_SASLFAIL'); + + # if we never received client data, + # these are just unknown mechanism errors. + if ($conn->{sasl_messages}) { + # TODO: check if they've failed 9000 times. + $conn->{sasl_failures}++; + } + + } + + # S - authentication success. + elsif ($done_mode eq 'S') { + $conn->numeric('RPL_SASLSUCCESS'); + delete $conn->{sasl_failures}; + $conn->{sasl_complete} = 1; + } + + # not sure. do NOT return, though. + else { + L("unknown SASL termination code $done_mode"); + } + + # SASL is complete. reset this stuff. + delete $conn->{sasl_agent}; + delete $conn->{sasl_messages}; + + return 1; +} + +sub saslset { + my ($server, $msg, + $source_serv, # services server + $serv_mask, # server mask + $target_uid, # target UID + $nick, # nickname or '*' + $ident, # ident or '*' + $cloak, # cloak or '*' + $act_name # account name or '*' + ) = @_; + + #=== Forward ===# + # it has to be me. + if (lc $serv_mask ne lc $me->name) { + $msg->forward_to_mask($serv_mask, sasl_done => @_[2..8]); + return 1; + } + + my $conn = find_connection($target_uid) or return; + + # update nick, ident, visual host. + if (!M::SASL::update_user_info($conn, $nick, $ident, $cloak)) { + L("failed to update user info"); + return; + } + + # TODO: for reauthentication, need to send out some broadcast command to + # notify other servers of several user field changes at once. this would be + # similar to TS6's SIGNON command. + + # update the account. + if (!M::SASL::update_account($conn, $act_name || undef)) { + L("failed to update account"); + return; + } + + return 1; +} + +sub saslmechs { + my ($server, $msg, + $source_serv, # services server + $serv_mask, # server mask + $source_uid, # source UID + $target_uid, # target UID + $mechs # mechanisms + ) = @_; + + # we don't do anything with this. + return 1 if lc $serv_mask eq lc $me->name; + + #=== Forward ===# + $msg->forward_to_mask($serv_mask, sasl_mechanisms => @_[2..6]); + + return 1; +} + +######################### +### OUTGOING COMMANDS ### +######################### + +sub out_saslhost { + my ( + $to_server, # server we're sending to + $source_serv, # source server + $target_mask, # server mask target + $source_uid, # juno UID source (might be unregistered) + $target_uid, # juno UID target + $temp_host, # the connection's temporary host + $temp_ip # the connection's temporary IP + ) = @_; + + return sprintf ':%s SASLHOST %s %s %s %s %s', + $source_serv->id, + $target_mask, + $source_uid, + $target_uid, + $temp_host, + $temp_ip; +} + +sub out_saslstart { + my ( + $to_server, # server we're sending to + $source_serv, # source server + $target_mask, # server mask target + $source_uid, # juno UID source (might be unregistered) + $target_uid, # juno UID target + $auth_method # authentication method; e.g. PLAIN + ) = @_; + + return sprintf ':%s SASLSTART %s %s %s %s', + $source_serv->id, + $target_mask, + $source_uid, + $target_uid, + $auth_method; +} + +sub out_sasldata { + my ( + $to_server, # server we're sending to + $source_serv, # source server + $target_mask, # server mask target + $source_uid, # juno UID source (might be unregistered) + $target_uid, # juno UID target + $client_data # base64 encoded data + ) = @_; + + return sprintf ':%s SASLDATA %s %s %s %s', + $source_serv->id, + $target_mask, + $source_uid, + $target_uid, + $client_data; +} + +sub out_sasldone { + my ( + $to_server, # server we're sending to + $source_serv, # source server + $target_mask, # server mask target + $source_uid, # juno UID source (might be unregistered) + $target_uid, # juno UID target + $done_mode # 'A' (aborted), 'F' (failed), or 'S' (succeeded) + ) = @_; + + return sprintf ':%s SASLDONE %s %s %s %s', + $source_serv->id, + $target_mask, + $source_uid, + $target_uid, + $done_mode; +} + +sub out_saslset { + my ( + $to_server, # server we're sending to + $source_serv, # source server + $target_mask, # server mask target + $source_uid, # juno UID source (might be unregistered) + $nick, # nickname or '*' + $ident, # ident or '*' + $cloak, # visible host or '*' + $act_name # account name or '*' + ) = @_; + + return sprintf ':%s SASLSET %s %s %s %s %s %s', + $source_serv->id, + $target_mask, + $source_uid, + $nick, + $ident, + $cloak, + $act_name; +} + +sub out_saslmechs { + my ( + $to_server, # server we're sending to + $source_serv, # source server + $target_mask, # server mask target + $source_uid, # juno UID source (might be unregistered) + $target_uid, # juno UID target + $mechs + ) = @_; + + return sprintf ':%s SASLMECHS %s %s %s :%s', + $source_serv->id, + $target_mask, + $source_uid, + $target_uid, + $mechs; +} + +# find the target connection. +# +# note that the target MAY OR MAY NOT be registered as a user. +# we are not yet supported registered users. +# +sub find_connection { + my $target_uid = shift; + my $conn = $pool->uid_in_use($target_uid); + + # TODO: not yet implemented + return if $conn && $conn->isa('user'); + + # not found + if (!$conn) { + L("could not find target connection for $target_uid"); + return; + } + + return $conn; +} + $mod diff --git a/modules/SASL/SASL.module/TS6.module/TS6.json b/modules/SASL/SASL.module/TS6.module/TS6.json index c4f6107b..0945b84a 100644 --- a/modules/SASL/SASL.module/TS6.module/TS6.json +++ b/modules/SASL/SASL.module/TS6.module/TS6.json @@ -6,5 +6,5 @@ "description" : "TS6 SASL implementation", "name" : "SASL::TS6", "package" : "M::SASL::TS6", - "version" : "1.6" + "version" : "1.8" } diff --git a/modules/SASL/SASL.module/TS6.module/TS6.pm b/modules/SASL/SASL.module/TS6.module/TS6.pm index bd7582d4..b290c55a 100644 --- a/modules/SASL/SASL.module/TS6.module/TS6.pm +++ b/modules/SASL/SASL.module/TS6.module/TS6.pm @@ -40,6 +40,7 @@ our %ts6_outgoing_commands = ( sasl_initiate => \&out_sasl_s, # sent to agent to initiate auth sasl_client_data => \&out_sasl_c, # sent to agent with data sasl_done => \&out_sasl_d, # sent to agent when aborted + sasl_mechanisms => \&out_sasl_m, # request mechanisms sasl_conn_info => \&out_svslogin # forwarding services-set user fields ); @@ -84,8 +85,16 @@ sub encap_sasl { $target_uid # UID of SASL service (these are swapped here) ); + # start + if ($mode eq 'S') { + $msg->forward_to_mask($serv_mask, sasl_initiate => + @common, + $data # authentication method + ); + } + # client data - if ($mode eq 'C') { + elsif ($mode eq 'C') { $msg->forward_to_mask($serv_mask, sasl_client_data => @common, $data # base64 encoded client data @@ -109,6 +118,14 @@ sub encap_sasl { ); } + # mechanisms + elsif ($mode eq 'M') { + $msg->forward_to_mask($serv_mask, sasl_mechanisms => + @common, + $data # mechanisms + ); + } + # don't know else { L("SASL $mode not known; not forwarded to $serv_mask"); @@ -331,6 +348,24 @@ sub out_sasl_d { $done_mode; } +sub out_sasl_m { + my ( + $to_server, # server we're sending to + $source_serv, # source server + $target_mask, # server mask target + $source_uid, # juno UID source (might be unregistered) + $target_uid, # juno UID target + $mechs + ) = @_; + + return sprintf ':%s ENCAP %s SASL %s %s M :%s', + ts6_id($source_serv), + $target_mask, + ts6_uid($source_uid), # convert UID to TS6 + ts6_uid($target_uid), + $mechs; # convrert UID to TS6 +} + sub out_svslogin { my ( $to_server, # server we're sending to