cgi-bin/accountcodes.pl

   1 package LJ;
   2 use strict;
   3
   4 # <LJFUNC>
   5 # name: LJ::acid_encode
   6 # des: Given a decimal number, returns base 30 encoding
   7 #      using an alphabet of letters & numbers that are
   8 #      not easily mistaken for each other.
   9 # returns: Base 30 encoding, alwyas 7 characters long.
  10 # args: number
  11 # des-number: Number to encode in base 30.
  12 # </LJFUNC>
  13 sub acid_encode
  14 {
  15     my $num = shift;
  16     my $acid = "";
  17     my $digits = "abcdefghjkmnpqrstvwxyz23456789";
  18     while ($num) {
  19         my $dig = $num % 30;
  20         $acid = substr($digits, $dig, 1) . $acid;
  21         $num = ($num - $dig) / 30;
  22     }
  23     return ("a"x(7-length($acid)) . $acid);
  24 }
  25
  26 # <LJFUNC>
  27 # name: LJ::acid_decode
  28 # des: Given an acid encoding from [func[LJ::acid_encode]],
  29 #      returns the original decimal number.
  30 # returns: Integer.
  31 # args: acid
  32 # des-acid: base 30 number from [func[LJ::acid_encode]].
  33 # </LJFUNC>
  34 sub acid_decode
  35 {
  36     my $acid = shift;
  37     $acid = lc($acid);
  38     my %val;
  39     my $digits = "abcdefghjkmnpqrstvwxyz23456789";
  40     for (0..30) { $val{substr($digits,$_,1)} = $_; }
  41     my $num = 0;
  42     my $place = 0;
  43     while ($acid) {
  44         return 0 unless ($acid =~ s/([$digits])$//o);
  45         $num += $val{$1} * (30 ** $place++);
  46     }
  47     return $num;
  48 }
  49
  50 # <LJFUNC>
  51 # name: LJ::acct_code_generate
  52 # des: Creates invitation code(s) from an optional userid
  53 #      for use by anybody.
  54 # returns: Code generated (if quantity 1),
  55 #          number of codes generated (if quantity>1),
  56 #          or undef on failure.
  57 # args: dbarg?, userid?, quantity?
  58 # des-userid: Userid to make the invitation code from,
  59 #             else the code will be from userid 0 (system)
  60 # des-quantity: Number of codes to generate (default 1)
  61 # </LJFUNC>
  62 sub acct_code_generate
  63 {
  64     &nodb;
  65     my $userid = int(shift);
  66     my $quantity = shift || 1;
  67
  68     my $dbh = LJ::get_db_writer();
  69
  70     my @authcodes = map {LJ::make_auth_code(5)} 1..$quantity;
  71     my @values = map {"(NULL, $userid, 0, '$_')"} @authcodes;
  72     my $sql = "INSERT INTO acctcode (acid, userid, rcptid, auth) "
  73             . "VALUES " . join(",", @values);
  74     my $num_rows = $dbh->do($sql) or return undef;
  75
  76     if ($quantity == 1) {
  77         my $acid = $dbh->{'mysql_insertid'} or return undef;
  78         return acct_code_encode($acid, $authcodes[0]);
  79     } else {
  80         return $num_rows;
  81     }
  82 }
  83
  84 # <LJFUNC>
  85 # name: LJ::acct_code_encode
  86 # des: Given an account ID integer and a 5 digit auth code, returns
  87 #      a 12 digit account code.
  88 # returns: 12 digit account code.
  89 # args: acid, auth
  90 # des-acid: account ID, a 4 byte unsigned integer
  91 # des-auth: 5 random characters from base 30 alphabet.
  92 # </LJFUNC>
  93 sub acct_code_encode
  94 {
  95     my $acid = shift;
  96     my $auth = shift;
  97     return lc($auth) . acid_encode($acid);
  98 }
  99
 100 # <LJFUNC>
 101 # name: LJ::acct_code_decode
 102 # des: Breaks an account code down into its two parts
 103 # returns: list of (account ID, auth code)
 104 # args: code
 105 # des-code: 12 digit account code
 106 # </LJFUNC>
 107 sub acct_code_decode
 108 {
 109     my $code = shift;
 110     return (acid_decode(substr($code, 5, 7)), lc(substr($code, 0, 5)));
 111 }
 112
 113 # <LJFUNC>
 114 # name: LJ::acct_code_check
 115 # des: Checks the validity of a given account code
 116 # returns: boolean; 0 on failure, 1 on validity. sets $$err on failure.
 117 # args: dbarg?, code, err?, userid?
 118 # des-code: account code to check
 119 # des-err: optional scalar ref to put error message into on failure
 120 # des-userid: optional userid which is allowed in the rcptid field,
 121 #             to allow for htdocs/create.bml case when people double
 122 #             click the submit button.
 123 # </LJFUNC>
 124 sub acct_code_check
 125 {
 126     &nodb;
 127     my $code = shift;
 128     my $err = shift;     # optional; scalar ref
 129     my $userid = shift;  # optional; acceptable userid (double-click proof)
 130
 131     my $dbh = LJ::get_db_writer();
 132
 133     unless (length($code) == 12) {
 134         $$err = "Malformed code; not 12 characters.";
 135         return 0;
 136     }
 137
 138     my ($acid, $auth) = acct_code_decode($code);
 139
 140     my $ac = $dbh->selectrow_hashref("SELECT userid, rcptid, auth ".
 141                                      "FROM acctcode WHERE acid=?",
 142                                      undef, $acid);
 143
 144     unless ($ac && $ac->{'auth'} eq $auth) {
 145         $$err = "Invalid account code.";
 146         return 0;
 147     }
 148
 149     if ($ac->{'rcptid'} && $ac->{'rcptid'} != $userid) {
 150         $$err = "This code has already been used: $code";
 151         return 0;
 152     }
 153
 154     # is the journal this code came from suspended?
 155     my $u = LJ::load_userid($ac->{'userid'});
 156     if ($u && $u->{'statusvis'} eq "S") {
 157         $$err = "Code belongs to a suspended account.";
 158         return 0;
 159     }
 160
 161     return 1;
 162 }
 163
 164
 165 1;