1#!/usr/bin/env perl
2
3use strict;
4
5open (DB, "< atheme.db")
6   or die "Can not open database $!";
7
8my (%user, %memo, %memoignore, %channel, %metadata, %serviceignore, %kline);
9
10sub db_load {
11   my ($numusers, $numchans, $numchanacs, $numklines) = (0, 0, 0, 0);
12   while (<DB>) {
13      # Get rid of \n
14      chomp;
15
16      # Database version
17      my @item = split /\ /, $_, 2;
18      die "db_load(): database version is $item[1]; I only understand version 4 (Atheme 0.2)"
19         if ($item[0] eq "DBV" and $item[1] > 4);
20
21      # Users
22      if ($item[0] eq "MU") {
23         my @item = split /\ /, $item[1], 9;
24         # First item is username
25         $user{$item[0]} = {
26            password     => $item[1],
27            email        => $item[2],
28            registered   => $item[3],
29            lastlogin    => $item[4],
30            failnum      => $item[5],
31            lastfailaddr => $item[6],
32            lastfailtime => $item[7],
33            flags        => $item[8],
34         };
35
36         $numusers++;
37      }
38
39      # Memos
40      if ($item[0] eq "ME") {
41         my @item = split /\ /, $item[1], 5;
42         # First item is recipient
43         $memo{$item[0]} = {
44            sender   => $item[1],
45            memotime => $item[2],
46            status   => $item[3],
47            text     => $item[4],
48         };
49
50         die "db_load(): memo for unknown account"
51            unless $user{$item[0]};
52      }
53
54      # Memo ignores
55      if ($item[0] eq "MI") {
56         my @item = split /\ /, $item[1], 2;
57         # First item is ignorer
58         $memoignore{$item[0]} = {
59            target => $item[1],
60         };
61
62         die "db_load(): invalid ignore (MI $item[0] $item[1])"
63            unless $user{$item[0]} and $user{$item[1]};
64      }
65
66      # Channels
67      if ($item[0] eq "MC") {
68         my @item = split /\ /, $item[1], 10;
69         # First argument is channel name
70         $channel{$item[0]} = {
71            password    => $item[1],
72            founder     => $item[2], # TODO: Try linking in a user hash
73            registered  => $item[3],
74            used        => $item[4],
75            flags       => $item[5],
76            mlock_on    => $item[6],
77            mlock_off   => $item[7],
78            mlock_limit => $item[8],
79            mlock_key   => $item[9],
80         };
81
82         $numchans++;
83      }
84
85      # Metadata
86      if ($item[0] eq "MD") {
87         my @item = split /\ /, $item[1], 4;
88         # Arguments are {type}{name}{property} = value
89         $metadata{$item[0]}{$item[1]}{$item[2]} = $item[3];
90      }
91
92      # Channel URLs
93      if ($item[0] eq "UR") {
94         my @item = split /\ /, $item[1], 2;
95         # First argument is channel name
96         $channel{$item[0]}{url} = $item[1];
97      }
98
99      # Channel entry messages
100      if ($item[0] eq "EM") {
101         my @item = split /\ /, $item[1], 2;
102         # First argument is channel name
103         $channel{$item[0]}{message} = $item[1];
104      }
105
106      # Channel access masks
107      if ($item[0] eq "CA") {
108         my @item = split /\ /, $item[1], 2;
109         # First argument is user name
110         # TODO: Disassemble chanacs and write appropriate access flags
111         $user{$item[0]}{chanacs} = $item[1];
112
113         $numchanacs++;
114      }
115
116      # Services ignores
117      if ($item[0] eq "SI") {
118         my @item = split /\ /, $item[1], 4;
119         # First argument is mask
120         $serviceignore{$item[0]} = {
121            settime => $item[1],
122            setby   => $item[2],
123            reason  => $item[3],
124         };
125      }
126
127      # K:Lines
128      if ($item[0] eq "KL") {
129         my @item = split /\ /, $item[1], 6;
130         # First argument is user
131         $kline{$item[0]} = {
132            host     => $item[1],
133            duration => $item[2],
134            settime  => $item[3],
135            setby    => $item[4],
136            reason   => $item[5],
137         };
138
139         $numklines++;
140      }
141
142      # End
143      if ($item[0] eq "DE") {
144         my @item = split /\ /, $item[1], 4;
145         die "db_load(): got $numusers myusers; expected $item[0]"
146            unless $item[0] == $numusers;
147         die "db_load(): got $numchans mychans; expected $item[1]"
148            unless $item[1] == $numchans;
149         die "db_load(): got $numchanacs chanacs; expected $item[2]"
150            unless $item[2] == $numchanacs;
151         die "db_load(): got $numklines klines; expected $item[3]"
152            unless $item[3] == $numklines;
153      }
154   }
155}
156
157db_load();
158print $user{$ARGV[0]}{password};
159