File Coverage

blib/lib/MySQL/GrantParser.pm

Criterion	Covered	Total	%
statement	86	120	71.6
branch	33	46	71.7
condition	2	9	22.2
subroutine	10	12	83.3
pod	2	6	33.3
total	133	193	68.9

package MySQL::GrantParser;

use strict;
use warnings;
use 5.008_005;

our $VERSION = '1.004';

use DBI;
use Carp;

sub new {
    my($class, %args) = @_;

    my $self = {
        dbh             => undef,
        need_disconnect => 0,
    };
    if (exists $args{dbh}) {
        $self->{dbh} = delete $args{dbh};
    } else {
        if (!$args{hostname} && !$args{socket}) {
            Carp::croak("missing mandatory args: hostname or socket");
        }

        my $dsn = "DBI:mysql:";
        for my $p (
            [qw(hostname hostname)],
            [qw(port port)],
            [qw(socket mysql_socket)],
        ) {
            my $arg_key   = $p->[0];
            my $param_key = $p->[1];
            if ($args{$arg_key}) {
                $dsn .= ";$param_key=$args{$arg_key}";
            }
        }

        $self->{need_disconnect} = 1;
        $self->{dbh} = DBI->connect(
            $dsn,
            $args{user}||'',
            $args{password}||'',
            {
                AutoCommit => 0,
            },
        ) or Carp::croak("$DBI::errstr ($DBI::err)");
    }

    $self->{server_version} =  exists $self->{dbh}->{mysql_serverversion} ? $self->{dbh}->{mysql_serverversion} : 0;

    return bless $self, $class;
}

sub parse {
    my $self = shift;
    my %grants;

    # select all user
    my $rset = $self->{dbh}->selectall_arrayref('SELECT user, host FROM mysql.user');

    for my $user_host (@$rset) {
        my ($user, $host) = @{$user_host};
        my $quoted_user_host = $self->quote_user($user, $host);
        my $rset = $self->{dbh}->selectall_arrayref("SHOW GRANTS FOR ${quoted_user_host}");
        my @stmts;
        for my $rs (@$rset) {
            push @stmts, @{$rs};
        }
        if ($self->{server_version} >= 50706) {
            # As of MySQL 5.7.6, SHOW GRANTS output does not include IDENTIFIED BY PASSWORD clauses. Use the SHOW CREATE USER statement instead.
            # https://dev.mysql.com/doc/refman/5.7/en/show-grants.html
            my $rset = $self->{dbh}->selectall_arrayref("SHOW CREATE USER ${quoted_user_host}");
            for my $rs (@$rset) {
                push @stmts, @{$rs};
            }
        }

        %grants = (%grants, %{ parse_stmts(\@stmts) });
    }

    return \%grants;
}

sub parse_stmts {
    my $stmts = shift;
    my @grants = ();
    my $q = q{['`]};
    my $Q = q{[^'`]};

    for my $stmt (@$stmts) {
        my $parsed = {
            with       => '',
            require    => '',
            identified => '',
            privs      => [],
            object     => '',
            user       => '',
            host       => '',
        };

        if ($stmt =~ s/\AGRANT (.+?) ON (.+?) TO ${q}(${Q}+?)${q}\@${q}(${Q}+?)${q}\s*//) {
            $parsed->{privs}  = parse_privs($1);
            $parsed->{object} = $2;
            $parsed->{user}   = $3;
            $parsed->{host}   = $4;
        }
        if ($stmt =~ s/\ACREATE USER ${q}(${Q}+?)${q}\@${q}(${Q}+?)${q}\s*//) {
            $parsed->{user}   = $1;
            $parsed->{host}   = $2;
        }

        if ($stmt =~ s/\AIDENTIFIED BY PASSWORD ${q}(${Q}+?)${q}\s*//) {
            $parsed->{identified} = "PASSWORD '$1'";
        }
        if ($stmt =~ s/\AIDENTIFIED WITH ${q}(${Q}+?)${q} AS ${q}(${Q}+?)${q}\s*//) {
            # my $auth_plugin = $1; # eg: mysql_native_password
            $parsed->{identified} = "PASSWORD '$2'";
        }
        if ($stmt =~ s/\AIDENTIFIED WITH ${q}(${Q}+?)${q}\s*//) {
            # no AS
            # my $auth_plugin = $1; # eg: mysql_native_password
            $parsed->{identified} = '';
        }

        if ($stmt =~ s/\AREQUIRE //) {
            if ($stmt =~ s/\ANONE\s*//) {
                $parsed->{require} = '';
            } elsif ($stmt =~ s/\A(SSL|X509)\s*//) {
                $parsed->{require} = $1;
            } else {
                my @tls_options = ();
                while ($stmt =~ s/\A((?:CIPHER|ISSUER|SUBJECT) ${q}${Q}+?${q})\s*//g) {
                    push @tls_options, $1;
                }
                $parsed->{require} = join ' ', @tls_options;
            }
        }

        if ($stmt =~ s/\AWITH //) {
            my @with = ();
            if ($stmt =~ s/\AGRANT OPTION\s*//) {
                push @with, 'GRANT OPTION';
            }
            while ($stmt =~ s/\A(MAX_\w+ \d+)\s*//g) {
                push @with, $1;
                $parsed->{object} ||= '*.*';
                $parsed->{privs} = ['USAGE'] unless @{ $parsed->{privs} };
            }
            $parsed->{with} = join ' ', @with;
        }

        push @grants, $parsed;
    }

    return pack_grants(@grants);
}

sub pack_grants {
    my @grants = @_;
    my $packed;

    for my $grant (@grants) {
        my $user       = delete $grant->{user};
        my $host       = delete $grant->{host};
        my $user_host  = join '@', $user, $host;
        my $object     = delete $grant->{object};
        my $identified = delete $grant->{identified};
        my $required   = delete $grant->{require};

        unless (exists $packed->{$user_host}) {
            $packed->{$user_host} = {
                user    => $user,
                host    => $host,
                objects => {},
                options => {
                    required   => '',
                    identified => '',
                },
            };
        }
        $packed->{$user_host}{objects}{$object}  = $grant if $object;
        $packed->{$user_host}{options}{required} = $required if $required;

        if ($identified) {
            $packed->{$user_host}{options}{identified} = $identified;
        }
    }

    return $packed;
}

sub quote_user {
    my $self = shift;
    my($user, $host) = @_;
    sprintf q{%s@%s}, $self->{dbh}->quote($user), $self->{dbh}->quote($host);
}

sub parse_privs {
    my $privs = shift;
    $privs .= ',';

    my @priv_list = ();

    while ($privs =~ /\G([^,(]+(?:\([^)]+\))?)\s*,\s*/g) {
        my $priv = $1;
        $priv =~ s/`//g; # trim quote for MySQL 8.0
        push @priv_list, $priv;
    }

    return \@priv_list;
}

sub DESTROY {
    my $self = shift;
    if ($self->{need_disconnect}) {
        $self->{dbh} && $self->{dbh}->disconnect;
    }
}

1;

__END__