#!/usr/bin/perl

# mk-show-grants canonicalizes and prints MySQL grants so you can effectively
# replicate, compare and version-control them.
#
# This program is copyright (c) 2007 Baron Schwartz.
# Feedback and improvements are welcome.
#
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
# licenses.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
# Place, Suite 330, Boston, MA  02111-1307  USA.

# TODO: search for obsolete grant statements.
# TODO: build a module that prints grants by inspecting the grant tables.
# Should be able to show stuff the grant system doesn't show.  Print grants in a
# way that can be done on earlier MySQL versions, with version-specific
# comments.

use strict;
use warnings FATAL => 'all';

# ###########################################################################
# OptionParser package 1178
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package OptionParser;

use Getopt::Long;
use List::Util qw(max);
use English qw(-no_match_vars);

sub new {
   my ( $class, @opts ) = @_;
   my %key_seen;
   my %long_seen;
   my %key_for;
   my %defaults;
   my @mutex;
   my @atleast1;
   my %long_for;
   my %disables;
   my %copyfrom;
   unshift @opts,
      { s => 'help',    d => 'Show this help message' },
      { s => 'version', d => 'Output version information and exit' };
   foreach my $opt ( @opts ) {
      if ( ref $opt ) {
         my ( $long, $short ) = $opt->{s} =~ m/^([\w-]+)(?:\|([^!+=]*))?/;
         $opt->{k} = $short || $long;
         $key_for{$long} = $opt->{k};
         $long_for{$opt->{k}} = $long;
         $long_for{$long} = $long;
         $opt->{l} = $long;
         die "Duplicate option $opt->{k}" if $key_seen{$opt->{k}}++;
         die "Duplicate long option $opt->{l}" if $long_seen{$opt->{l}}++;
         $opt->{t} = $short;
         $opt->{n} = $opt->{s} =~ m/!/;
         $opt->{g} ||= 'o';
         if ( (my ($y) = $opt->{s} =~ m/=([mdHhAaz])/) ) {
            $opt->{y} = $y;
            $opt->{s} =~ s/=./=s/;
         }
         $opt->{r} = $opt->{d} =~ m/required/;
         if ( (my ($def) = $opt->{d} =~ m/default(?: ([^)]+))?/) ) {
            $defaults{$opt->{k}} = defined $def ? $def : 1;
         }
         if ( (my ($dis) = $opt->{d} =~ m/(disables .*)/) ) {
            $disables{$opt->{k}} = [ $class->get_participants($dis) ];
         }
      }
      else { # It's an instruction.

         if ( $opt =~ m/at least one|mutually exclusive|one and only one/ ) {
            my @participants = map {
                  die "No such option '$_' in $opt" unless $long_for{$_};
                  $long_for{$_};
               } $class->get_participants($opt);
            if ( $opt =~ m/mutually exclusive|one and only one/ ) {
               push @mutex, \@participants;
            }
            if ( $opt =~ m/at least one|one and only one/ ) {
               push @atleast1, \@participants;
            }
         }
         elsif ( $opt =~ m/default to/ ) {
            my @participants = map {
                  die "No such option '$_' in $opt" unless $long_for{$_};
                  $key_for{$_};
               } $class->get_participants($opt);
            $copyfrom{$participants[0]} = $participants[1];
         }

      }
   }

   foreach my $dis ( keys %disables ) {
      $disables{$dis} = [ map {
            die "No such option '$_' while processing $dis" unless $long_for{$_};
            $long_for{$_};
         } @{$disables{$dis}} ];
   }

   return bless {
      specs => [ grep { ref $_ } @opts ],
      notes => [],
      instr => [ grep { !ref $_ } @opts ],
      mutex => \@mutex,
      defaults => \%defaults,
      long_for => \%long_for,
      atleast1 => \@atleast1,
      disables => \%disables,
      key_for  => \%key_for,
      copyfrom => \%copyfrom,
      strict   => 1,
      groups   => [ { k => 'o', d => 'Options' } ],
   }, $class;
}

sub get_participants {
   my ( $self, $str ) = @_;
   my @participants;
   foreach my $thing ( $str =~ m/(--?[\w-]+)/g ) {
      if ( (my ($long) = $thing =~ m/--(.+)/) ) {
         push @participants, $long;
      }
      else {
         foreach my $short ( $thing =~ m/([^-])/g ) {
            push @participants, $short;
         }
      }
   }
   return @participants;
}

sub parse {
   my ( $self, %defaults ) = @_;
   my @specs = @{$self->{specs}};
   my %factor_for = (k => 1_024, M => 1_048_576, G => 1_073_741_824);

   my %opt_seen;
   my %vals = %{$self->{defaults}};
   @vals{keys %defaults} = values %defaults;
   foreach my $spec ( @specs ) {
      $vals{$spec->{k}} = undef unless defined $vals{$spec->{k}};
      $opt_seen{$spec->{k}} = 1;
   }

   foreach my $key ( keys %defaults ) {
      die "Cannot set default for non-existent option '$key'\n"
         unless $opt_seen{$key};
   }

   Getopt::Long::Configure('no_ignore_case', 'bundling');
   GetOptions( map { $_->{s} => \$vals{$_->{k}} } @specs )
      or $self->error('Error parsing options');

   if ( $vals{version} ) {
      my $prog = $self->prog;
      printf("%s  Ver %s Distrib %s Changeset %s\n",
         $prog, $main::VERSION, $main::DISTRIB, $main::SVN_REV);
      exit(0);
   }

   if ( @ARGV && $self->{strict} ) {
      $self->error("Unrecognized command-line options @ARGV");
   }

   foreach my $dis ( grep { defined $vals{$_} } keys %{$self->{disables}} ) {
      my @disses = map { $self->{key_for}->{$_} } @{$self->{disables}->{$dis}};
      @vals{@disses} = map { undef } @disses;
   }

   foreach my $spec ( grep { $_->{r} } @specs ) {
      if ( !defined $vals{$spec->{k}} ) {
         $self->error("Required option --$spec->{l} must be specified");
      }
   }

   foreach my $mutex ( @{$self->{mutex}} ) {
      my @set = grep { defined $vals{$self->{key_for}->{$_}} } @$mutex;
      if ( @set > 1 ) {
         my $note = join(', ',
            map { "--$self->{long_for}->{$_}" }
                @{$mutex}[ 0 .. scalar(@$mutex) - 2] );
         $note .= " and --$self->{long_for}->{$mutex->[-1]}"
               . " are mutually exclusive.";
         $self->error($note);
      }
   }

   foreach my $required ( @{$self->{atleast1}} ) {
      my @set = grep { defined $vals{$self->{key_for}->{$_}} } @$required;
      if ( !@set ) {
         my $note = join(', ',
            map { "--$self->{long_for}->{$_}" }
                @{$required}[ 0 .. scalar(@$required) - 2] );
         $note .= " or --$self->{long_for}->{$required->[-1]}";
         $self->error("Specify at least one of $note");
      }
   }

   foreach my $spec ( grep { $_->{y} && defined $vals{$_->{k}} } @specs ) {
      my $val = $vals{$spec->{k}};
      if ( $spec->{y} eq 'm' ) {
         my ( $num, $suffix ) = $val =~ m/(\d+)([smhd])$/;
         if ( $suffix ) {
            $val = $suffix eq 's' ? $num            # Seconds
                 : $suffix eq 'm' ? $num * 60       # Minutes
                 : $suffix eq 'h' ? $num * 3600     # Hours
                 :                  $num * 86400;   # Days
            $vals{$spec->{k}} = $val;
         }
         else {
            $self->error("Invalid --$spec->{l} argument");
         }
      }
      elsif ( $spec->{y} eq 'd' ) {
         my $from_key = $self->{copyfrom}->{$spec->{k}};
         my $default = {};
         if ( $from_key ) {
            $default = $self->{dsn}->parse($self->{dsn}->as_string($vals{$from_key}));
         }
         $vals{$spec->{k}} = $self->{dsn}->parse($val, $default);
      }
      elsif ( $spec->{y} eq 'z' ) {
         my ($pre, $num, $factor) = $val =~ m/^([+-])?(\d+)([kMG])?$/;
         if ( defined $num ) {
            if ( $factor ) {
               $num *= $factor_for{$factor};
            }
            $vals{$spec->{k}} = ($pre || '') . $num;
         }
         else {
            $self->error("Invalid --$spec->{l} argument");
         }
      }
   }

   foreach my $spec ( grep { $_->{y} } @specs ) {
      my $val = $vals{$spec->{k}};
      if ( $spec->{y} eq 'H' || (defined $val && $spec->{y} eq 'h') ) {
         $vals{$spec->{k}} = { map { $_ => 1 } split(',', ($val || '')) };
      }
      elsif ( $spec->{y} eq 'A' || (defined $val && $spec->{y} eq 'a') ) {
         $vals{$spec->{k}} = [ split(',', ($val || '')) ];
      }
   }

   return %vals;
}

sub error {
   my ( $self, $note ) = @_;
   $self->{__error__} = 1;
   push @{$self->{notes}}, $note;
}

sub prog {
   (my $prog) = $PROGRAM_NAME =~ m/([.A-Za-z-]+)$/;
   return $prog || $PROGRAM_NAME;
}

sub prompt {
   my ( $self ) = @_;
   my $prog   = $self->prog;
   my $prompt = $self->{prompt} || '<options>';
   return "Usage: $prog $prompt\n";
}

sub descr {
   my ( $self ) = @_;
   my $prog = $self->prog;
   my $descr  = $prog . ' ' . ($self->{descr} || '')
          . "  For more details, please use the --help option, "
          . "or try 'perldoc $prog' for complete documentation.";
   $descr = join("\n", $descr =~ m/(.{0,80})(?:\s+|$)/g);
   $descr =~ s/ +$//mg;
   return $descr;
}

sub usage_or_errors {
   my ( $self, %opts ) = @_;
   if ( $opts{help} ) {
      print $self->usage(%opts);
      exit(0);
   }
   elsif ( $self->{__error__} ) {
      print $self->errors();
      exit(0);
   }
}

sub errors {
   my ( $self ) = @_;
   my $usage = $self->prompt() . "\n";
   if ( (my @notes = @{$self->{notes}}) ) {
      $usage .= join("\n  * ", 'Errors in command-line arguments:', @notes) . "\n";
   }
   return $usage . "\n" . $self->descr();
}

sub usage {
   my ( $self, %vals ) = @_;
   my @specs = @{$self->{specs}};

   my $maxl = max(map { length($_->{l}) + ($_->{n} ? 4 : 0)} @specs);

   my $maxs = max(0,
      map { length($_->{l}) + ($_->{n} ? 4 : 0)}
      grep { $_->{t} } @specs);

   my $lcol = max($maxl, ($maxs + 3));
   my $rcol = 80 - $lcol - 6;
   my $rpad = ' ' x ( 80 - $rcol );

   $maxs = max($lcol - 3, $maxs);

   my $usage = $self->descr() . "\n" . $self->prompt();
   foreach my $g ( @{$self->{groups}} ) {
      $usage .= "\n$g->{d}:\n";
      foreach my $spec ( sort { $a->{l} cmp $b->{l} } grep { $_->{g} eq $g->{k} } @specs ) {
         my $long  = $spec->{n} ? "[no]$spec->{l}" : $spec->{l};
         my $short = $spec->{t};
         my $desc  = $spec->{d};
         $desc = join("\n$rpad", grep { $_ } $desc =~ m/(.{0,$rcol})(?:\s+|$)/g);
         $desc =~ s/ +$//mg;
         if ( $short ) {
            $usage .= sprintf("  --%-${maxs}s -%s  %s\n", $long, $short, $desc);
         }
         else {
            $usage .= sprintf("  --%-${lcol}s  %s\n", $long, $desc);
         }
      }
   }

   if ( (my @instr = @{$self->{instr}}) ) {
      $usage .= join("\n", map { "  $_" } @instr) . "\n";
   }
   if ( $self->{dsn} ) {
      $usage .= "\n" . $self->{dsn}->usage();
   }
   $usage .= "\nOptions and values after processing arguments:\n";
   foreach my $spec ( sort { $a->{l} cmp $b->{l} } @specs ) {
      my $val   = $vals{$spec->{k}};
      my $type  = $spec->{y} || '';
      my $bool  = $spec->{s} =~ m/^[\w-]+(?:\|[\w-])?!?$/;
      $val      = $bool                     ? ( $val ? 'TRUE' : 'FALSE' )
                : !defined $val             ? '(No value)'
                : $type eq 'd'              ? $self->{dsn}->as_string($val)
                : $type =~ m/H|h/           ? join(',', sort keys %$val)
                : $type =~ m/A|a/           ? join(',', @$val)
                :                             $val;
      $usage .= sprintf("  --%-${lcol}s  %s\n", $spec->{l}, $val);
   }
   return $usage;
}

sub prompt_noecho {
   shift @_ if ref $_[0] eq __PACKAGE__;
   my ( $prompt ) = @_;
   local $OUTPUT_AUTOFLUSH = 1;
   print $prompt;
   my $response;
   eval {
      require Term::ReadKey;
      Term::ReadKey::ReadMode('noecho');
      chomp($response = <STDIN>);
      Term::ReadKey::ReadMode('normal');
      print "\n";
   };
   if ( $EVAL_ERROR ) {
      die "Cannot read response; is Term::ReadKey installed? $EVAL_ERROR";
   }
   return $response;
}

sub groups {
   my ( $self, @groups ) = @_;
   push @{$self->{groups}}, @groups;
}

1;

# ###########################################################################
# End OptionParser package
# ###########################################################################

# ###########################################################################
# DSNParser package 1149
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package DSNParser;

sub new {
   my ( $class, @opts ) = @_;
   my $self = {
      opts => {
         D => {
            desc => 'Database to use',
            dsn  => 'database',
            copy => 1,
         },
         F => {
            desc => 'Only read default options from the given file',
            dsn  => 'mysql_read_default_file',
            copy => 1,
         },
         h => {
            desc => 'Connect to host',
            dsn  => 'host',
            copy => 1,
         },
         p => {
            desc => 'Password to use when connecting',
            dsn  => 'password',
            copy => 1,
         },
         P => {
            desc => 'Port number to use for connection',
            dsn  => 'port',
            copy => 1,
         },
         S => {
            desc => 'Socket file to use for connection',
            dsn  => 'mysql_socket',
            copy => 1,
         },
         u => {
            desc => 'User for login if not current user',
            dsn  => 'user',
            copy => 1,
         },
      },
   };
   foreach my $opt ( @opts ) {
      $self->{opts}->{$opt->{key}} = { desc => $opt->{desc}, copy => $opt->{copy} };
   }
   return bless $self, $class;
}

sub prop {
   my ( $self, $prop, $value ) = @_;
   if ( @_ > 2 ) {
      $self->{$prop} = $value;
   }
   return $self->{$prop};
}

sub parse {
   my ( $self, $dsn, $prev, $defaults ) = @_;
   return unless $dsn;
   $prev     ||= {};
   $defaults ||= {};
   my %vals;
   my %opts = %{$self->{opts}};
   if ( $dsn !~ m/=/ && $self->prop('autokey') ) {
      $vals{ $self->prop('autokey') } = $dsn;
   }
   else {
      my %hash = map { m/^(.)=(.*)$/g } split(/,/, $dsn);
      foreach my $key ( keys %opts ) {
         $vals{$key} = $hash{$key};
         if ( !defined $vals{$key} && defined $prev->{$key} && $opts{$key}->{copy} ) {
            $vals{$key} = $prev->{$key};
         }
         if ( !defined $vals{$key} ) {
            $vals{$key} = $defaults->{$key};
         }
      }
      foreach my $key ( keys %hash ) {
         die "Unrecognized DSN part '$key' in '$dsn'\n"
            unless exists $opts{$key};
      }
   }
   if ( (my $required = $self->prop('required')) ) {
      foreach my $key ( keys %$required ) {
         die "Missing DSN part '$key' in '$dsn'\n" unless $vals{$key};
      }
   }
   return \%vals;
}

sub as_string {
   my ( $self, $dsn ) = @_;
   return $dsn unless ref $dsn;
   return join(',', map { "$_=$dsn->{$_}" } grep { defined $dsn->{$_} } sort keys %$dsn );
}

sub usage {
   my ( $self ) = @_;
   my $usage
      = "DSN syntax is key=value[,key=value...]  Allowable DSN keys:\n"
      . "  KEY  COPY  MEANING\n"
      . "  ===  ====  =============================================\n";
   my %opts = %{$self->{opts}};
   foreach my $key ( sort keys %opts ) {
      $usage .= "  $key    "
             .  ($opts{$key}->{copy} ? 'yes   ' : 'no    ')
             .  ($opts{$key}->{desc} || '[No description]')
             . "\n";
   }
   if ( (my $key = $self->prop('autokey')) ) {
      $usage .= "  If the DSN is a bareword, the word is treated as the '$key' key.\n";
   }
   return $usage;
}

sub get_cxn_params {
   my ( $self, $info ) = @_;
   my $dsn;
   my %opts = %{$self->{opts}};
   my $driver = $self->prop('dbidriver') || '';
   if ( $driver eq 'Pg' ) {
      $dsn = 'DBI:Pg:dbname=' . ( $info->{D} || '' ) . ';'
         . join(';', map  { "$opts{$_}->{dsn}=$info->{$_}" }
                     grep { defined $info->{$_} }
                     qw(h P));
   }
   else {
      $dsn = 'DBI:mysql:' . ( $info->{D} || '' ) . ';'
         . join(';', map  { "$opts{$_}->{dsn}=$info->{$_}" }
                     grep { defined $info->{$_} }
                     qw(F h P S))
         . ';mysql_read_default_group=mysql';
   }
   return ($dsn, $info->{u}, $info->{p});
}

1;

# ###########################################################################
# End DSNParser package
# ###########################################################################

package main;

use DBI;
use English qw(-no_match_vars);

our $VERSION = '1.0.5';
our $DISTRIB = '1316';
our $SVN_REV = sprintf("%d", q$Revision: 1312 $ =~ m/(\d+)/g || 0);

# ############################################################################
# Get configuration information.
# ############################################################################

my @opt_spec = (
   { s => 'askpass',           d => 'Prompt for password for connections' },
   { s => 'database|D=s',      d => 'Database to use' },
   { s => 'defaults-file|F=s', d => 'Only read mysql options from the given file' },
   { s => 'drop|d',            d => 'Add DROP USER before each user' },
   { s => 'flush|f',           d => 'Add FLUSH PRIVILEGES' },
   { s => 'host|h=s',          d => 'Connect to host' },
   { s => 'ignore|i=s',        d => 'Ignore this comma-separated list of users' },
   { s => 'only|o=s',          d => 'Only show grants for this comma-separated list of users' },
   { s => 'password|p=s',      d => 'Password to use when connecting' },
   { s => 'port|P=i',          d => 'Port number to use for connection' },
   { s => 'revoke|r',          d => 'Add REVOKE statements' },
   { s => 'separate|s',        d => 'List each GRANT or REVOKE separately' },
   { s => 'socket|S=s',        d => 'Socket file to use for connection' },
   { s => 'user|u=s',          d => 'User for login if not current user' },
);

my $dsn_parser = new DSNParser();
my $opt_parser = new OptionParser(@opt_spec);
$opt_parser->{prompt} = '<options>';
$opt_parser->{descr} = q{shows grants (user privileges) from a MySQL server.};
my %opts = $opt_parser->parse();
$opt_parser->usage_or_errors(%opts);

# Turn comma-separated lists into arrays and hashes
if ( $opts{o} ) {
   my @users = map {
         my ( $user, $host ) = parse_user($_);
         { User => $user, Host => $host };
      }
      grep { $_ =~ m/\S/ }
      split(/,\s*/, $opts{o});
   $opts{o} = \@users;
}
if ( $opts{i} ) {
   my @users = map {
         my ( $user, $host ) = parse_user($_);
         "'$user'\@'$host'";
      }
      grep { $_ =~ m/\S/ }
      split(/,\s*/, $opts{i});
   $opts{i} = { map { $_ => 1 } @users };
}

# Connect to the database
if ( !$opts{p} && $opts{askpass} ) {
   $opts{p} = OptionParser::prompt_noecho("Enter password: ");
}
my $dbh = DBI->connect($dsn_parser->get_cxn_params(\%opts), { AutoCommit => 1, RaiseError => 1, PrintError => 0 } );

my ( $version, $ts ) = $dbh->selectrow_array("SELECT VERSION(), NOW()");
print join("\n",
   "-- Grants dumped by mk-show-grants $VERSION",
   "-- Dumped from server " . ($dbh->{mysql_hostinfo} || '') . ", MySQL $version at $ts",
   ), "\n";

my $users = $opts{o} || $dbh->selectall_arrayref(
   'SELECT DISTINCT User, Host FROM mysql.user ORDER BY User, Host',
   { Slice => {} });

my $exit_status;

foreach my $u (@$users) {
   next if $opts{i} && $opts{i}->{"'$u->{User}'\@'$u->{Host}'"};

   my @grants;
   eval {
      @grants = @{ $dbh->selectcol_arrayref(
         "SHOW GRANTS FOR '$u->{User}'\@'$u->{Host}'") };
   };
   if ( $EVAL_ERROR ) {
      $exit_status = 1;
   }
   next unless @grants;

   if ( $opts{s} ) { # List each grant separately.
      @grants = map {
         my ( $grants, $on_what ) = $_ =~ m/GRANT (.*?) ON ((?:`|\*).*)$/;
         map { "GRANT $_ ON $on_what" } split(', ', $grants);
      } @grants;
      my $count;
      # If the row with IDENTIFIED BY has multiple grants, this will create many
      # such rows; strip it from all but the first.
      @grants = map {
         if ( $_ =~ m/IDENTIFIED BY/ ) {
            if ( $count++ ) {
               $_ =~ s/ IDENTIFIED BY.*//;
            }
         }
         $_;
      } @grants;
   }
   else { # Sort the actual grants lexically within each row for consistency.
      @grants = map {
         $_ =~ s/GRANT (.*?) ON (`|\*)/"GRANT " . join(', ', sort(split(', ', $1))) . " ON $2"/e;
         $_;
      } @grants;
   }

   # Sort the grant rows for consistency too, but the one with the password
   # should always come first.
   @grants = sort {
      $b =~ m/IDENTIFIED BY/ <=> $a =~ m/IDENTIFIED BY/ || $a cmp $b
   } @grants;

   # Print REVOKE statements.
   if ( $opts{r} ) {
      my @revoke = map {
         my @result;
         my ( $grants, $on_what, $user ) = $_
            =~ m/GRANT (.*?) ON ((?:`|\*).*?) TO ('[^']+'\@'[^']+')/;
         if ( $opts{s} ) {
            @result = map { "REVOKE $_ ON $on_what FROM $user" } split(', ', $grants);
         }
         else {
            @result = "REVOKE $grants ON $on_what FROM $user";
         }
         if ( $_ =~ m/WITH GRANT OPTION/ ) { # The WITH GRANT OPTION must be revoked separately
            push @result, "REVOKE GRANT OPTION ON *.* FROM $user" if $user;
         }
         @result;
      } @grants;

      print join(
         "\n",
         "-- Revoke statements for '$u->{User}'\@'$u->{Host}'",
         map {"$_;"} @revoke),
         "\n";
   }

   if ( $opts{d} ) {
      print join("\n",
         "DROP USER '$u->{User}'\@'$u->{Host}';",
         "DELETE FROM `mysql`.`user` WHERE `User`='$u->{User}' AND `Host`='$u->{Host}';",
         ), "\n";
   }
   
   print join( "\n", "-- Grants for '$u->{User}'\@'$u->{Host}'", map {"$_;"} @grants ), "\n";

   if ( $opts{f} && $opts{s} ) {
      print "FLUSH PRIVILEGES;\n";
   }

   $exit_status = 0;
}

if ( $opts{f} && !$opts{s} ) {
   print "FLUSH PRIVILEGES;\n";
}

$dbh->disconnect;
exit($exit_status);

# ############################################################################
# Subroutines
# ############################################################################
sub parse_user {
   my ( $spec ) = @_;
   my ( $user, $host )
      = $spec =~ m/
         ^               # Beginning of line
         '?([^'@]*)'?    # Username optionally enclosed by '
         (?:
            @            # Followed by @
            '?([^']*?)'? # And host optionally enclosed by '
         )?              # ... which is all optional
         $               # End of line
         /xms;
   $host ||= '%';
   return ( $user, $host );
}

# ############################################################################
# Documentation
# ############################################################################

=pod

=head1 NAME

mk-show-grants - Canonicalize and print MySQL grants so you can effectively
replicate, compare and version-control them.

=head1 SYNOPSIS

   mk-show-grants
   mk-show-grants --separate --revoke | diff othergrants.sql -

=head1 OPTIONS

=over

=item --askpass

Prompt for password for connections.

=item --database

Database to use.

=item --defaults-file

Only read default options from the given file.

=item --drop

Adds DROP USER before each user in the output.

=item --flush

Adds FLUSH PRIVILEGES after output.  You might need this on pre-4.1.1 servers
if you want to drop a user completely.

=item --help

Displays a help message.

=item --host

Connect to host.

=item --ignore

Ignore this comma-separated list of users.

=item --only

Only print grants for this comma-separated list of users.

=item --password

Password to use when connecting.

=item --port

Port number to use for connection.

=item --revoke

Add REVOKE statements for each GRANT statement.

=item --separate

Lists each GRANT or REVOKE separately, instead of the default output from
MySQL's SHOW GRANTS command, which may list many privileges on a single line.
With L<"--flush">, places a FLUSH PRIVILEGES after each user, instead of once
at the end of all the output.

=item --socket

Socket file to use for connection.

=item --user

User for login if not current user.

=item --version

Output version information and exit.

=back

=head1 DESCRIPTION

mk-show-grants extracts, orders, and then prints grants for MySQL user
accounts.

Why would you want this?  There are several reasons.

The first is to easily replicate users from one server to another; you can
simply extract the grants from the first server and pipe the output directly
into another server.

The second use is to place your grants into version control.  If you do a daily
automated grant dump into version control, you'll get lots of spurious
changesets for grants that don't change, because MySQL prints the actual grants
out in a seemingly random order.  For instance, one day it'll say

  GRANT DELETE, INSERT, UPDATE ON `test`.* TO 'foo'@'%';

And then another day it'll say

  GRANT INSERT, DELETE, UPDATE ON `test`.* TO 'foo'@'%';

The grants haven't changed, but the order has.  This script sorts the grants
within the line, between 'GRANT' and 'ON'.  If there are multiple rows from SHOW
GRANTS, it sorts the rows too, except that it always prints the row with the
user's password first, if it exists.  This removes three kinds of inconsistency
you'll get from running SHOW GRANTS, and avoids spurious changesets in version
control.

Third, if you want to diff grants across servers, it will be hard without
"canonicalizing" them, which mk-show-grants does.  The output is fully
diff-able.

With the L<"--revoke">, L<"--separate"> and other options, mk-show-grants
also makes it easy to revoke specific privileges from users.  This is tedious
otherwise.

=head1 SEE ALSO

Someone pointed out that this has been done before (not surprising, as it's not
all that complicated).  Visit L<http://www.futhark.ch/mysql/139.html> for a simpler
implementation of the same general concept, though without the canonicalization.
I borrowed the idea of adding DROP USER from that script, and it inspired me
to add the REVOKE functionality too.

=head1 BUGS

Please use the Sourceforge bug tracker, forums, and mailing lists to request
support or report bugs: L<http://sourceforge.net/projects/maatkit/>.

=head1 SYSTEM REQUIREMENTS

You need the following Perl modules: DBI and DBD::mysql.

=head1 LICENSE

This program is copyright (c) 2007 Baron Schwartz.
Feedback and improvements are welcome.

THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
systems, you can issue `man perlgpl' or `man perlartistic' to read these
licenses.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place, Suite 330, Boston, MA  02111-1307  USA.

=head1 AUTHOR

Baron Schwartz.

=head1 VERSION

This manual page documents Ver 1.0.5 Distrib 1316 $Revision: 1312 $.

=cut
