AnyEvent-MySQL

 view release on metacpan or  search on metacpan

lib/AnyEvent/MySQL/Imp.pm  view on Meta::CPAN

use AnyEvent::Handle;
use Digest::SHA1 qw(sha1);
use List::Util qw(reduce);
use Scalar::Util qw(dualvar);

use constant {
    DEV => 0,
};

use constant {
    CLIENT_LONG_PASSWORD      =>      1, # new more secure passwords +
    CLIENT_FOUND_ROWS         =>      2, # Found instead of affected rows *
    CLIENT_LONG_FLAG          =>      4, # Get all column flags * +
    CLIENT_CONNECT_WITH_DB    =>      8, # One can specify db on connect +
    CLIENT_NO_SCHEMA          =>     16, # Don't allow database.table.column
    CLIENT_COMPRESS           =>     32, # Can use compression protocol *
    CLIENT_ODBC               =>     64, # Odbc client
    CLIENT_LOCAL_FILES        =>    128, # Can use LOAD DATA LOCAL *
    CLIENT_IGNORE_SPACE       =>    256, # Ignore spaces before '(' *
    CLIENT_PROTOCOL_41        =>    512, # New 4.1 protocol +
    CLIENT_INTERACTIVE        =>   1024, # This is an interactive client * +

lib/AnyEvent/MySQL/Imp.pm  view on Meta::CPAN

                        push @row, \@cell;
                        $fetch_row->();
                    }
                });
            };
            $fetch_row->();
        }
    });
}

=head2 do_auth($hd, $username, [$password, [$database,]] $cb->($success, $err_num_and_msg, $thread_id))
=cut
sub do_auth {
    my $cb = ref($_[-1]) eq 'CODE' ? pop : sub {};
    my($hd, $username, $password, $database) = @_;

    recv_packet($hd, sub {
        if( DEV ) {
            my $hex = $_[0];
            $hex =~ s/(.)/sprintf"%02X ",ord$1/ges;
            my $ascii = $_[0];
            $ascii =~ s/([^\x20-\x7E])/./g;
            warn $hex, $ascii;
        }
        my $proto_ver = take_num($_[0], 1); warn "proto_ver:$proto_ver" if DEV;

lib/AnyEvent/MySQL/Imp.pm  view on Meta::CPAN

            warn "  CLIENT_TRANSACTIONS" if( $server_cap & CLIENT_TRANSACTIONS );
            warn "  CLIENT_RESERVED" if( $server_cap & CLIENT_RESERVED );
            warn "  CLIENT_SECURE_CONNECTION" if( $server_cap & CLIENT_SECURE_CONNECTION );
            warn "  CLIENT_MULTI_STATEMENTS" if( $server_cap & CLIENT_MULTI_STATEMENTS );
            warn "  CLIENT_MULTI_RESULTS" if( $server_cap & CLIENT_MULTI_RESULTS );
        }
        my $scramble_len = take_num($_[0], 1); warn "scramble_len:$scramble_len" if DEV;

        my $packet = '';
        put_num($packet, $server_cap & (
            CLIENT_LONG_PASSWORD     | # new more secure passwords
            CLIENT_FOUND_ROWS        | # Found instead of affected rows
            CLIENT_LONG_FLAG         | # Get all column flags
            CLIENT_CONNECT_WITH_DB   | # One can specify db on connect
            # CLIENT_NO_SCHEMA         | # Don't allow database.table.column
            # CLIENT_COMPRESS          | # Can use compression protocol
            # CLIENT_ODBC              | # Odbc client
            # CLIENT_LOCAL_FILES       | # Can use LOAD DATA LOCAL
            # CLIENT_IGNORE_SPACE      | # Ignore spaces before '('
            CLIENT_PROTOCOL_41       | # New 4.1 protocol
            # CLIENT_INTERACTIVE       | # This is an interactive client

lib/AnyEvent/MySQL/Imp.pm  view on Meta::CPAN

            # CLIENT_RESERVED          | # Old flag for 4.1 protocol 
            CLIENT_SECURE_CONNECTION | # New 4.1 authentication
            CLIENT_MULTI_STATEMENTS  | # Enable/disable multi-stmt support
            CLIENT_MULTI_RESULTS     | # Enable/disable multi-results
            0
        ), 4); # client_flags
        put_num($packet, 0x1000000, 4); # max_packet_size
        put_num($packet, $server_lang, 1); # charset_number
        $packet .= "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; # filler
        put_zstr($packet, $username); # username
        if( $password eq '' ) {
            put_lcs($packet, '');
        }
        else {
            my $stage1_hash = sha1($password);
            put_lcs($packet, sha1($scramble_buff.sha1($stage1_hash)) ^ $stage1_hash); # scramble buff
        }
        put_zstr($packet, $database); # database name

        send_packet($hd, 1, $packet);
        recv_packet($hd, sub {
            if( parse_ok($_[0]) ) {
                $cb->(1, undef, $thread_id);
            }
            else {