init
This commit is contained in:
104
livejournal/htdocs/admin/capedit.bml
Executable file
104
livejournal/htdocs/admin/capedit.bml
Executable file
@@ -0,0 +1,104 @@
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%FORM);
|
||||
|
||||
my ($sth, $ret);
|
||||
my $mode = $FORM{'mode'};
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
$mode ||= $FORM{'user'} ? "viewuser" : "intro";
|
||||
|
||||
my $user = LJ::canonical_username($FORM{'user'});
|
||||
my $u;
|
||||
$u = LJ::load_user($user) if $user;
|
||||
|
||||
if ($mode eq "intro")
|
||||
{
|
||||
$ret .= "<h1>capability class management</h1>\n";
|
||||
$ret .= "<form method='get'>";
|
||||
$ret .= "Modify capabilities for user: <input name='user' size='15'> <input type='submit' value=\"Load\">";
|
||||
$ret .= "</form>";
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
if ($mode eq "save")
|
||||
{
|
||||
return "<b>Error:</b> requires post"
|
||||
unless (LJ::did_post());
|
||||
|
||||
return"<b>Error:</b> You don't have access to change a user's capability class."
|
||||
unless (LJ::check_priv($remote, "admin", "*"));
|
||||
|
||||
unless ($u) {
|
||||
$ret .= "Unknown user.\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
my @cap_add = ();
|
||||
my @cap_del = ();
|
||||
my $newcaps = $u->{caps};
|
||||
foreach my $n (sort { $a <=> $b } keys %LJ::CAP) {
|
||||
if ($FORM{"class_$n"}) {
|
||||
push @cap_add, $n;
|
||||
$newcaps |= (1 << $n);
|
||||
} else {
|
||||
push @cap_del, $n;
|
||||
$newcaps &= ~(1 << $n);
|
||||
}
|
||||
}
|
||||
|
||||
# note which caps were changed and log $logmsg to statushistory
|
||||
my $add_txt = join(",", @cap_add);
|
||||
my $del_txt = join(",", @cap_del);
|
||||
LJ::statushistory_add($u->{'userid'}, $remote->{'userid'},
|
||||
"capedit", "add: $add_txt, del: $del_txt\n");
|
||||
|
||||
LJ::modify_caps($u, \@cap_add, \@cap_del)
|
||||
or return"<b>Error:</b> Unable to modify caps.";
|
||||
|
||||
# $u->{caps} is now updated in memory for later in this request
|
||||
$u->{caps} = $newcaps;
|
||||
|
||||
$ret .= "Saved.";
|
||||
$mode = "viewuser";
|
||||
}
|
||||
|
||||
if ($mode eq "viewuser")
|
||||
{
|
||||
$ret .= "<h1><a href='capedit.bml'><<</a> edit user '$user'</h1>\n";
|
||||
|
||||
unless ($u) {
|
||||
$ret .= "Unknown user.\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
$ret .= "<form method='post'>";
|
||||
$ret .= "<input type='hidden' name='mode' value='save'>\n";
|
||||
$ret .= "<input type='hidden' name='user' value='$user'>\n";
|
||||
foreach my $n (sort { $a <=> $b } keys %LJ::CAP)
|
||||
{
|
||||
my $on = ($u->{'caps'}+0) & (1 << $n);
|
||||
my $checked = $on ? " checked='1'" : "";
|
||||
$ret .= "<p><input type='checkbox' name='class_$n' value='1' id='class_$n' $checked> ";
|
||||
my $name = $LJ::CAP{$n}->{'_name'} || "Unnamed capability class \#$n";
|
||||
if ($on) { $ret .= "<b>"; }
|
||||
$ret .= "<label for='class_$n'>$name</label>";
|
||||
if ($on) { $ret .= "</b>"; }
|
||||
}
|
||||
|
||||
$ret .= "<p><input type='submit' value='Save'>\n";
|
||||
$ret .= "</form>";
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
return "Unknown mode.";
|
||||
|
||||
_code?><?_c <LJDEP>
|
||||
lib: cgi-bin/ljlib.pl
|
||||
form: htdocs/admin/capedit.bml
|
||||
post: htdocs/admin/capedit.bml
|
||||
</LJDEP _c?>
|
||||
47
livejournal/htdocs/admin/clusterstatus.bml
Executable file
47
livejournal/htdocs/admin/clusterstatus.bml
Executable file
@@ -0,0 +1,47 @@
|
||||
<?page
|
||||
title=>Cluster Status
|
||||
body<=
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return "<?needlogin?>" unless $remote;
|
||||
return "<?h1 Error h1?><?p You do not have the necessary privilege (supporthelp) to use this page. p?>"
|
||||
unless LJ::check_priv($remote, 'supporthelp');
|
||||
|
||||
my $ret;
|
||||
foreach my $cid (@LJ::CLUSTERS) {
|
||||
my $name = LJ::get_cluster_description($cid) || 'no name';
|
||||
|
||||
$ret .= "<b>$name</b>: ";
|
||||
|
||||
my $check = 0;
|
||||
if ($LJ::READONLY_CLUSTER{$cid}) {
|
||||
$ret .= "<strong>read-only for all users</strong>";
|
||||
} elsif ($LJ::READONLY_CLUSTER_ADVISORY{$cid} eq 'when_needed') {
|
||||
$ret .= "<strong>read-only for free users during load</strong>",
|
||||
} elsif ($LJ::READONLY_CLUSTER_ADVISORY{$cid}) {
|
||||
$ret .= "<strong>read-only for free users</strong>";
|
||||
} else {
|
||||
$ret .= "no known issues";
|
||||
$check = 1;
|
||||
}
|
||||
|
||||
if ($check) {
|
||||
my $dbcm = LJ::get_cluster_master($cid);
|
||||
if ($dbcm) {
|
||||
$ret .= "; available";
|
||||
} else {
|
||||
$ret .= "; <span style='color: red;'>unavailable</a>";
|
||||
}
|
||||
}
|
||||
|
||||
$ret .= "<br />";
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
_code?>
|
||||
<=body
|
||||
page?>
|
||||
104
livejournal/htdocs/admin/console/index.bml
Executable file
104
livejournal/htdocs/admin/console/index.bml
Executable file
@@ -0,0 +1,104 @@
|
||||
<html>
|
||||
<head><title>Admin Console</title></head>
|
||||
<body>
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%POST %cmd);
|
||||
|
||||
my ($ret, $sth);
|
||||
|
||||
my $commands = $POST{'commands'};
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
if ($commands)
|
||||
{
|
||||
unless (LJ::did_post()) {
|
||||
return "<b>Error:</b> requires post.";
|
||||
}
|
||||
|
||||
if ($remote && $remote->{'user'} ne $POST{'remoteuser'}) {
|
||||
return "<b>Error:</b> invalid user.";
|
||||
}
|
||||
|
||||
$ret .= "[ <A HREF=\"./\">console</A> | <A HREF=\"reference.bml\">reference</A> ]<P>";
|
||||
|
||||
foreach my $cmd (split(/\n/, $commands))
|
||||
{
|
||||
my @args = LJ::Con::parse_line($cmd);
|
||||
next unless @args;
|
||||
|
||||
my $first = 1;
|
||||
$ret .= "<P><TABLE BORDER=1 CELLPADDING=5><TR>";
|
||||
foreach (@args) {
|
||||
my $arg = BML::eall($_);
|
||||
if ($first) {
|
||||
$ret .= "<TD><B>$arg</B></TD>";
|
||||
$first = 0;
|
||||
} else {
|
||||
$ret .= "<TD>$arg</TD>";
|
||||
}
|
||||
}
|
||||
$ret .= "</TR></TABLE>";
|
||||
|
||||
my @output;
|
||||
my $rv;
|
||||
|
||||
# TODO: make the entire console library not take $db args.
|
||||
my $dbh = LJ::get_db_writer();
|
||||
$rv = LJ::Con::execute($dbh, $remote, \@args, \@output);
|
||||
|
||||
unless ($rv) { $ret .= "<P><B><FONT COLOR=#FF0000>Failed!</FONT></B>"; }
|
||||
if (@output) {
|
||||
$ret .= "<PRE><B>";
|
||||
foreach my $line (@output) {
|
||||
my $color = "#000000";
|
||||
if ($line->[0] eq "error") {
|
||||
$color = "#FF0000";
|
||||
}
|
||||
if ($line->[0] eq "info") {
|
||||
$color = "#008800";
|
||||
}
|
||||
|
||||
$ret .= "<FONT COLOR=$color>".LJ::eall($line->[1])."</FONT>\n";
|
||||
|
||||
}
|
||||
$ret .= "</B></PRE>";
|
||||
}
|
||||
}
|
||||
|
||||
$ret .= "<form method=post><p>";
|
||||
$ret .= "<tt>enter commands:</tt><br>";
|
||||
$ret .= LJ::html_hidden('remoteuser', $remote->{'user'}) if $remote;
|
||||
$ret .= "<textarea name=commands rows=3 cols=60 wrap=off></textarea> ";
|
||||
$ret .= "<input type=submit value=\"execute\"></form>\n";
|
||||
|
||||
return $ret;
|
||||
|
||||
}
|
||||
else
|
||||
{
|
||||
$ret .= "[ console | <A HREF=\"reference.bml\">reference</A> ]<P>";
|
||||
|
||||
$ret .= "<FORM METHOD=POST>";
|
||||
$ret .= LJ::html_hidden('remoteuser', $remote->{'user'}) if $remote;
|
||||
$ret .= "<TABLE WIDTH=400><TR VALIGN=BOTTOM>";
|
||||
$ret .= "<TD><IMG SRC=\"$LJ::IMGPREFIX/nerd_small.jpg\" WIDTH=167 HEIGHT=169 HSPACE=2 VSPACE=2></TD>";
|
||||
$ret .= "<TD><B><TT>command console.</TT></B>";
|
||||
$ret .= "<P>welcome to the livejournal console. from here administrators can do administrative type things. you will forget the commands, so there is a <A HREF=\"reference.bml\">reference</A>.</TD>";
|
||||
$ret .= "</TR>";
|
||||
$ret .= "<TR><TD COLSPAN=2>";
|
||||
$ret .= "<P><tt>enter commands:</tt><BR>";
|
||||
$ret .= "<TEXTAREA NAME=commands ROWS=10 COLS=60 WRAP=OFF></TEXTAREA></TD></TR>\n";
|
||||
$ret .= "<TR><TD COLSPAN=2 ALIGN=RIGHT><INPUT TYPE=SUBMIT VALUE=\"execute\"></P></TD></TR></TABLE></FORM>\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
_code?>
|
||||
</body>
|
||||
</html>
|
||||
<?_c <LJDEP>
|
||||
lib: cgi-bin/console.pl, cgi-bin/ljlib.pl
|
||||
link: htdocs/admin/console/reference.bml
|
||||
post: htdocs/admin/console/index.bml
|
||||
</LJDEP> _c?>
|
||||
49
livejournal/htdocs/admin/console/reference.bml
Executable file
49
livejournal/htdocs/admin/console/reference.bml
Executable file
@@ -0,0 +1,49 @@
|
||||
<html><head><title>Console Reference</title></head>
|
||||
<body>
|
||||
|
||||
[ <a href="./">console</a> | reference ]
|
||||
|
||||
<P><B>Grammar</B>
|
||||
<BR>Think of this like a DOS or <tt>bash</tt> prompt. The first word is a command. Every word after that is an argument to that command. Every command has a different number of required and optional parameters. White space delimits arguments. If you need a space in an argument, put double quotes around the whole thing. If you need double quotes and spaces in an argument, escape the quote with a backslash (\) first. If you need to do a backslash, escape that with a backslash.
|
||||
<P>It's pretty straight-forward. If you're confused, ask.
|
||||
|
||||
<P><B>Command Reference</B>
|
||||
<BR>Arguments in <angle brackets> are required. Arguments in [brackets] are optional. If there is more than one optional argument, you can't skip one and provide one after it. Once you skip one, you have to skip the rest.
|
||||
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%cmd);
|
||||
|
||||
my ($ret, $sth);
|
||||
|
||||
$ret .= "<dl>";
|
||||
foreach my $cmdname (sort keys %LJ::Con::cmd)
|
||||
{
|
||||
my $cmd = $LJ::Con::cmd{$cmdname};
|
||||
next if ($cmd->{'hidden'});
|
||||
|
||||
my $args = LJ::ehtml($cmd->{'argsummary'});
|
||||
my $anchor = "cmd.$cmdname";
|
||||
$ret .= "<a name='$anchor'><dt><p><table width=100% cellpadding=2><tr><td bgcolor=#d0d0d0>";
|
||||
$ret .= "<tt><a style='text-decoration: none' href='\#$anchor'><b>$cmdname</b></a> $args</tt></td></tr></table>";
|
||||
$ret .= "</dt><dd><p>$cmd->{'des'}";
|
||||
if ($cmd->{'args'}) {
|
||||
my @des = @{$cmd->{'args'}};
|
||||
$ret .= "<p><dl>";
|
||||
while (my ($arg, $des) = splice(@des, 0, 2)) {
|
||||
$ret .= "<dt><b><i>$arg</i></b></dt><dd>$des</dd>";
|
||||
}
|
||||
$ret .= "</dl>";
|
||||
}
|
||||
$ret .= "</dd></a>";
|
||||
}
|
||||
$ret .= "</dl>";
|
||||
return $ret;
|
||||
|
||||
_code?>
|
||||
|
||||
</body></html><?_c <LJDEP>
|
||||
lib: cgi-bin/console.pl, cgi-bin/ljlib.pl
|
||||
link: htdocs/admin/console/index.bml
|
||||
</LJDEP> _c?>
|
||||
200
livejournal/htdocs/admin/dbadmin.bml
Executable file
200
livejournal/htdocs/admin/dbadmin.bml
Executable file
@@ -0,0 +1,200 @@
|
||||
<html>
|
||||
<head><title>DB Admin - <?sitename?></title>
|
||||
<style>
|
||||
p, td { font-size: 9pt; font-family: sans-serif; }
|
||||
input { font-size: 8pt; font-family: sans-serif; }
|
||||
</style>
|
||||
</head>
|
||||
<body bgcolor='#000000' text='#ffffff' link='#eeeeee' vlink='#eeeeee'>
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%FORM);
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
my $remote = LJ::get_remote($dbh);
|
||||
|
||||
return"<b>Error:</b> You don't have access to administer databases."
|
||||
unless (LJ::check_priv($dbh, $remote, "siteadmin", "dbweightview"));
|
||||
|
||||
my $can_save = LJ::check_priv($dbh, $remote, "siteadmin", "dbweightchange");
|
||||
|
||||
my $view = $FORM{'view'} eq "role" ? "role" : "host";
|
||||
|
||||
my %dbinfo; # dbid
|
||||
my %slaves; # dbid
|
||||
my $sth;
|
||||
$sth = $dbh->prepare("SELECT dbid, name, fdsn, masterid FROM dbinfo");
|
||||
$sth->execute;
|
||||
while ($_ = $sth->fetchrow_hashref) {
|
||||
next unless $_->{'dbid'};
|
||||
$dbinfo{$_->{'dbid'}} = $_;
|
||||
push @{$slaves{$_->{'masterid'}}}, $_->{'dbid'};
|
||||
}
|
||||
|
||||
my %weights;
|
||||
my %role;
|
||||
my %roletweight;
|
||||
$sth = $dbh->prepare("SELECT dbid, role, norm, curr FROM dbweights");
|
||||
$sth->execute;
|
||||
while ($_ = $sth->fetchrow_hashref) {
|
||||
next unless defined $dbinfo{$_->{'dbid'}};
|
||||
$weights{$_->{'dbid'}}->{$_->{'role'}} = $_;
|
||||
push @{$role{$_->{'role'}}}, $_->{'dbid'};
|
||||
$roletweight{$_->{'role'}} += $_->{'curr'};
|
||||
}
|
||||
|
||||
my $ret;
|
||||
my $p = sub { $ret .= shift; };
|
||||
my $status;
|
||||
|
||||
if ($can_save && defined $FORM{'action:save'}) {
|
||||
return "<b>Error:</b> Not a POST request." unless LJ::did_post();
|
||||
|
||||
my $curr_changed = 0;
|
||||
foreach my $k (keys %FORM) {
|
||||
next unless $k =~ /^set-(\d+)-(\w+?)-(\w+)$/;
|
||||
my ($sid, $role, $what) = ($1, $2, $3);
|
||||
next unless $what eq "norm" or $what eq "curr";
|
||||
next unless defined $weights{$sid};
|
||||
next unless defined $weights{$sid}->{$role};
|
||||
my $val = $FORM{$k}+0;
|
||||
my $old = $weights{$sid}->{$role}->{$what};
|
||||
next if $val == $old;
|
||||
|
||||
$dbh->do("UPDATE dbweights SET $what=$val WHERE ".
|
||||
"dbid=$sid AND role='$role'");
|
||||
$weights{$sid}->{$role}->{$what} = $val;
|
||||
if ($what eq "curr") {
|
||||
$curr_changed = 1;
|
||||
$roletweight{$role} += $val - $old;
|
||||
}
|
||||
}
|
||||
|
||||
if ($curr_changed) {
|
||||
if ($LJ::DBCONFIG_WRITE_CONFIG) {
|
||||
my $good = 1;
|
||||
my $newcfg = "# auto-generated config from /admin/dbadmin.bml. changes will be overwritten!\n";
|
||||
$newcfg .= "%LJ::DBINFO = (\n";
|
||||
foreach my $id (sort keys %dbinfo) {
|
||||
next unless $id > 0;
|
||||
my $dbinf = $dbinfo{$id};
|
||||
my $name = $dbinf->{'name'};
|
||||
if ($dbinf->{'masterid'} == 0) { $name = "master"; }
|
||||
$newcfg .= "\t'$name' => {\n";
|
||||
$newcfg .= "\t\t'_fdsn' => \"$dbinf->{fdsn}\",\n";
|
||||
$newcfg .= "\t\t'role' => {\n";
|
||||
foreach my $role (sort keys %{$weights{$id} || {}}) {
|
||||
$newcfg .= "\t\t\t'$role' => $weights{$id}->{$role}->{'curr'},\n";
|
||||
}
|
||||
$newcfg .= "\t\t},\n";
|
||||
$newcfg .= "\t},\n";
|
||||
}
|
||||
$newcfg .= ");\n";
|
||||
$newcfg .= "\$LJ::DBINFO{'master'}->{'role'}->{'master'} = 1;\n";
|
||||
$newcfg .= "1;\n";
|
||||
|
||||
if (open(CFG, ">$ENV{'LJHOME'}/cgi-bin/dbconfig.pl")) {
|
||||
print CFG $newcfg;
|
||||
close CFG;
|
||||
open (TCH, ">>$ENV{'LJHOME'}/cgi-bin/ljconfig.pl");
|
||||
close TCH;
|
||||
}
|
||||
|
||||
$status .= "<p>Wrote config.</p>";
|
||||
} else {
|
||||
my $newserial = LJ::procnotify_add("DBI::Role::reload");
|
||||
$status .= "<p>New Serial: $newserial</p>\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $single = sub {
|
||||
my $role = shift;
|
||||
return @{$role{$role}} == 1;
|
||||
};
|
||||
|
||||
my $slaveroleperc = sub {
|
||||
my $sid = shift;
|
||||
my $role = shift;
|
||||
return sprintf("%0.1f%%", 100*$weights{$sid}->{$role}->{'curr'}/($roletweight{$role}||1));
|
||||
};
|
||||
|
||||
my $dumpslaves = sub
|
||||
{
|
||||
my $mid = shift;
|
||||
my $depth = shift;
|
||||
my $rec = shift;
|
||||
return unless $slaves{$mid};
|
||||
|
||||
my $indent = " " x ($depth*5);
|
||||
|
||||
foreach my $sid (sort { $#{$slaves{$a}} <=> $#{$slaves{$b}} } @{$slaves{$mid}}) {
|
||||
my $db = $dbinfo{$sid};
|
||||
$p->("<tr bgcolor='#404070'><td colspan='4'><b>$indent$db->{'name'}</b> ($sid)</td></tr>");
|
||||
|
||||
foreach my $role (sort keys %{$weights{$sid}}) {
|
||||
my $r = $weights{$sid}->{$role};
|
||||
my $col;
|
||||
if ($r->{'norm'} != $r->{'curr'}) {
|
||||
$col = "bgcolor='#800000'";
|
||||
}
|
||||
$p->("<tr valign='bottom' $col><td>$indent$role</td>");
|
||||
$p->("<td align='center'><input size='3' name='set-$sid-$role-norm' value='$r->{'norm'}'></td>");
|
||||
$p->("<td align='center'><input size='3' name='set-$sid-$role-curr' value='$r->{'curr'}'></td>");
|
||||
$p->("<td>" . $slaveroleperc->($sid, $role) . "</td>");
|
||||
$p->("</tr>");
|
||||
}
|
||||
$rec->($sid, $depth+1, $rec);
|
||||
}
|
||||
};
|
||||
|
||||
my $dumprole = sub
|
||||
{
|
||||
my $role = shift;
|
||||
return if $single->($role);
|
||||
$p->("<tr bgcolor='#404070'><td colspan='4'><b>$role</b></td></tr>");
|
||||
|
||||
foreach my $sid (sort { $weights{$b}->{$role}->{'curr'} <=> $weights{$a}->{$role}->{'curr'} } @{$role{$role}})
|
||||
{
|
||||
my $r = $weights{$sid}->{$role};
|
||||
my $col;
|
||||
$col = "bgcolor='#800000'" if $r->{'norm'} != $r->{'curr'};
|
||||
$p->("<tr valign='bottom' $col><td>$dbinfo{$sid}->{'name'}</td>");
|
||||
$p->("<td align='center'><input size='3' name='set-$sid-$role-norm' value='$r->{'norm'}'></td>");
|
||||
$p->("<td align='center'><input size='3' name='set-$sid-$role-curr' value='$r->{'curr'}'></td>");
|
||||
$p->("<td>" . $slaveroleperc->($sid, $role) . "</td>");
|
||||
$p->("</tr>");
|
||||
}
|
||||
};
|
||||
|
||||
$p->('<form method="post" action="dbadmin.bml">');
|
||||
$p->("<input type='hidden' name='view' value='$view'>");
|
||||
$p->('<table cellpadding="1" border="0" bgcolor="#606060">');
|
||||
|
||||
my $hr = "<b>Host</b> / <a href='dbadmin.bml?view=role'>Role</a>";
|
||||
if ($view eq "role") {
|
||||
$hr = "<a href='dbadmin.bml?view=host'>Host</a> / <b>Role</b>";
|
||||
}
|
||||
|
||||
$p->("<tr bgcolor='#404040'><td>$hr</td><td><b>Norm</b></td><td><b>Curr</b></td><td>%</td></tr>");
|
||||
if ($view eq "role") {
|
||||
foreach my $role (sort keys %role) {
|
||||
$dumprole->($role);
|
||||
}
|
||||
} else {
|
||||
$dumpslaves->(0, 0, $dumpslaves); # root
|
||||
}
|
||||
if ($can_save) {
|
||||
$p->('<tr><td colspan="4" align="center" bgcolor="#404040"><input type="submit" name="action:refresh" value="Refresh"> ');
|
||||
$p->('<input type="submit" name="action:save" value="Save"></td></tr>');
|
||||
}
|
||||
$p->('</table>');
|
||||
$p->('</form>');
|
||||
$p->($status);
|
||||
|
||||
return $ret;
|
||||
|
||||
_code?>
|
||||
</body>
|
||||
</html>
|
||||
100
livejournal/htdocs/admin/faq/faqedit.bml
Executable file
100
livejournal/htdocs/admin/faq/faqedit.bml
Executable file
@@ -0,0 +1,100 @@
|
||||
<?_info
|
||||
nocache=>1
|
||||
_info?><?page
|
||||
title=><?_code return $FORM{'id'} ? "Edit FAQ Item #$FORM{'id'}" : "Add to FAQ"; _code?>
|
||||
body<=
|
||||
|
||||
<CENTER>
|
||||
<A HREF="./"><B>(Back to FAQ Index)</B></A>
|
||||
</CENTER>
|
||||
|
||||
|
||||
<FORM ACTION="faqedit_do.bml" METHOD=POST>
|
||||
<?_code
|
||||
|
||||
$id = $FORM{'id'} + 0;
|
||||
$ret = "";
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
my %ac_edit;
|
||||
my %ac_add;
|
||||
LJ::remote_has_priv($remote, "faqadd", \%ac_add);
|
||||
|
||||
if ($id)
|
||||
{
|
||||
LJ::remote_has_priv($remote, "faqedit", \%ac_edit);
|
||||
my $sth = $dbh->prepare("SELECT question, answer, faqcat, sortorder FROM faq WHERE faqid=$id");
|
||||
$sth->execute;
|
||||
($question, $answer, $faqcat, $sortorder) = $sth->fetchrow_array or
|
||||
return "<b>Error:</b> FAQ #$id does not exist.";
|
||||
|
||||
$q = LJ::ehtml($question);
|
||||
$a = LJ::ehtml($answer);
|
||||
|
||||
unless ($ac_edit{'*'} || $ac_edit{$faqcat}) {
|
||||
if (%ac_edit) {
|
||||
return "<B>Error: </B> You do not have access to edit a FAQ question in the \"$faqcat\" category.";
|
||||
} else {
|
||||
return "<B>Error: </B> You do not have access to edit the FAQ.";
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
unless (%ac_add) {
|
||||
return "<B>Error: </B> You do not have access to add to the FAQ.";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
$sortorder += 0;
|
||||
$sortorder ||= 50;
|
||||
|
||||
$ret .= "<INPUT TYPE=HIDDEN NAME=id VALUE=$id>\n";
|
||||
$ret .= "<P>Category: <SELECT NAME=\"faqcat\"><OPTION VALUE=\"\">\n";
|
||||
|
||||
my $sth = $dbh->prepare("SELECT faqcat, faqcatname FROM faqcat ORDER BY catorder");
|
||||
$sth->execute;
|
||||
while (($fc, $fcname) = $sth->fetchrow_array)
|
||||
{
|
||||
if ($id) {
|
||||
next unless ($ac_add{'*'} || $ac_add{$fc} || ($fc eq $faqcat));
|
||||
} else {
|
||||
next unless ($ac_add{'*'} || $ac_add{$fc});
|
||||
}
|
||||
$selected = ($fc eq $faqcat) ? " SELECTED" : "";
|
||||
$ret .= "<OPTION VALUE=\"$fc\"$selected>" . LJ::ehtml($fcname) . "\n";
|
||||
}
|
||||
|
||||
$ret .= "</SELECT>";
|
||||
$ret .= "SortOrder (1-100): <INPUT NAME=sortorder SIZE=5 MAXLENGTH=4 VALUE=$sortorder>";
|
||||
$ret .= "<BR><FONT SIZE=-1>(sort order is how to sort within the category. categories themselves are also sorted.)</FONT>";
|
||||
|
||||
$ret .= "<P><B>Question:</B> (as brief as possible, do not span multiple lines)<BR><TEXTAREA NAME=\"q\" ROWS=3 COLS=70 WRAP=SOFT>$q</TEXTAREA><BR><FONT SIZE=-1>(erase question to delete FAQ entry)</FONT>\n";
|
||||
$ret .= "<P><B>Answer:</B> (long as you want, give URLs to links, not HTML)<BR><TEXTAREA NAME=\"a\" ROWS=15 COLS=70 WRAP=SOFT>$a</TEXTAREA>\n";
|
||||
|
||||
my $faqd = LJ::Lang::get_dom("faq");
|
||||
if ($faqd) {
|
||||
$ret .= "<p><b>Select modification level:</b> ";
|
||||
$ret .= LJ::html_select({ 'name' => "sev", "selected" => 1 },
|
||||
0 => "Typo/etc (no notify)",
|
||||
1 => "Minor (notify translators)",
|
||||
2 => "Major (require translation updates)");
|
||||
$ret .= "</p>";
|
||||
}
|
||||
|
||||
|
||||
$ret .= "<P><INPUT TYPE=SUBMIT VALUE=\"Add/Edit FAQ Item\">";
|
||||
return $ret;
|
||||
|
||||
_code?>
|
||||
|
||||
</FORM>
|
||||
|
||||
<=body
|
||||
page?><?_c <LJDEP>
|
||||
lib: cgi-bin/ljlib.pl
|
||||
post: htdocs/admin/faq/faqedit_do.bml
|
||||
</LJDEP> _c?>
|
||||
109
livejournal/htdocs/admin/faq/faqedit_do.bml
Executable file
109
livejournal/htdocs/admin/faq/faqedit_do.bml
Executable file
@@ -0,0 +1,109 @@
|
||||
<?_info
|
||||
nocache=>1
|
||||
_info?><?page
|
||||
title=><?_code return $FORM{'id'} ? "Edit FAQ Item #$FORM{'id'}" : "Add to FAQ"; _code?>
|
||||
body<=
|
||||
|
||||
<CENTER>
|
||||
<A HREF="./"><B>(Back to FAQ Index)</B></A>
|
||||
</CENTER>
|
||||
<P>
|
||||
|
||||
<?_code
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
my %ac_edit;
|
||||
my %ac_add;
|
||||
|
||||
$id = $FORM{'id'} + 0;
|
||||
$ret = "";
|
||||
|
||||
$qq = $dbh->quote($FORM{'q'});
|
||||
$qa = $dbh->quote($FORM{'a'});
|
||||
$qfaqcat = $dbh->quote($FORM{'faqcat'});
|
||||
|
||||
$sortorder = $FORM{'sortorder'}+0 || 50;
|
||||
|
||||
return "<?requirepost?>" unless LJ::did_post();
|
||||
|
||||
if ($id)
|
||||
{
|
||||
LJ::remote_has_priv($remote, "faqedit", \%ac_edit);
|
||||
my $sth = $dbh->prepare("SELECT faqcat FROM faq WHERE faqid=$id");
|
||||
$sth->execute;
|
||||
my ($faqcat) = $sth->fetchrow_array;
|
||||
|
||||
unless ($ac_edit{'*'} || $ac_edit{$faqcat}) {
|
||||
if (%ac_edit) {
|
||||
return "<B>Error: </B> You do not have access to edit a FAQ question in the \"$faqcat\" category.";
|
||||
} else {
|
||||
return "<B>Error: </B> You do not have access to edit the FAQ.";
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
LJ::remote_has_priv($remote, "faqadd", \%ac_add);
|
||||
unless ($ac_add{'*'} || $ac_add{$FORM{'faqcat'}}) {
|
||||
return "<B>Error: </B> You do not have access to add FAQ questions in this category";
|
||||
}
|
||||
}
|
||||
|
||||
my $faqd = LJ::Lang::get_dom("faq");
|
||||
my $rlang = LJ::Lang::get_root_lang($faqd);
|
||||
unless ($rlang) { undef $faqd; }
|
||||
my $opts = {
|
||||
'changeseverity' => $FORM{'sev'}+0,
|
||||
};
|
||||
my $do_trans = sub {
|
||||
my $id = shift;
|
||||
return unless $faqd;
|
||||
LJ::Lang::set_text($dbh, $faqd->{'dmid'}, $rlang->{'lncode'},
|
||||
"$id.1question", $FORM{'q'}, $opts);
|
||||
LJ::Lang::set_text($dbh, $faqd->{'dmid'}, $rlang->{'lncode'},
|
||||
"$id.2answer", $FORM{'a'}, $opts);
|
||||
};
|
||||
|
||||
unless ($id)
|
||||
{
|
||||
unless ($FORM{'faqcat'})
|
||||
{
|
||||
return "<B>Error: </B> You did not select a FAQ category.";
|
||||
}
|
||||
$dbh->do("INSERT INTO faq (faqid, question, answer, faqcat, sortorder, lastmoduserid, lastmodtime) VALUES (NULL, $qq, $qa, $qfaqcat, $sortorder, $remote->{'userid'}, NOW())");
|
||||
$id = $dbh->{'mysql_insertid'};
|
||||
$ret .= $dbh->errstr || "Added FAQ item. All good.";
|
||||
|
||||
$opts->{'childrenlatest'} = 1;
|
||||
$do_trans->($id) if $id;
|
||||
}
|
||||
else
|
||||
{
|
||||
|
||||
if ($FORM{'q'} =~ /\S/)
|
||||
{
|
||||
$dbh->do("UPDATE faq SET question=$qq, answer=$qa, faqcat=$qfaqcat, lastmoduserid=$remote->{'userid'}, lastmodtime=NOW(), sortorder=$sortorder WHERE faqid=$id");
|
||||
$ret .= "Updated FAQ item. All good. faqid is <b><a href='$LJ::SITEROOT/support/faqbrowse.bml?faqid=$id'>$id</a></b>";
|
||||
|
||||
$do_trans->($id);
|
||||
}
|
||||
else
|
||||
{
|
||||
$dbh->do("DELETE FROM faq WHERE faqid=$id");
|
||||
$ret .= "FAQ item deleted.";
|
||||
|
||||
# TODO: delete translation from ml_* ?
|
||||
}
|
||||
}
|
||||
|
||||
return $ret;
|
||||
|
||||
_code?>
|
||||
|
||||
<=body
|
||||
page?><?_c <LJDEP>
|
||||
lib: cgi-bin/ljlib.pl
|
||||
link: htdocs/admin/faq/index.bml
|
||||
</LJDEP> _c?>
|
||||
67
livejournal/htdocs/admin/faq/index.bml
Executable file
67
livejournal/htdocs/admin/faq/index.bml
Executable file
@@ -0,0 +1,67 @@
|
||||
<?_info
|
||||
nocache=>1
|
||||
_info?><?page
|
||||
title=>FAQ
|
||||
body<=
|
||||
|
||||
<?_code
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
my %ac_add;
|
||||
my %ac_edit;
|
||||
LJ::remote_has_priv($remote, "faqadd", \%ac_add);
|
||||
LJ::remote_has_priv($remote, "faqedit", \%ac_edit);
|
||||
|
||||
$ret = "";
|
||||
if (%ac_add)
|
||||
{
|
||||
$ret .= "<A HREF=\"faqedit.bml\">[Add to FAQ]</A>\n";
|
||||
}
|
||||
|
||||
my %faqcat;
|
||||
my %faqq;
|
||||
$sth = $dbh->prepare("SELECT faqcat, faqcatname, catorder FROM faqcat");
|
||||
$sth->execute;
|
||||
while ($_ = $sth->fetchrow_hashref)
|
||||
{
|
||||
$faqcat{$_->{'faqcat'}} = $_;
|
||||
}
|
||||
|
||||
$sth = $dbh->prepare("SELECT faqid, question, sortorder, faqcat, lastmodtime FROM faq");
|
||||
$sth->execute;
|
||||
while ($_ = $sth->fetchrow_hashref)
|
||||
{
|
||||
$faqq{$_->{'faqcat'}}->{$_->{'faqid'}} = $_;
|
||||
}
|
||||
|
||||
foreach my $faqcat (sort { $faqcat{$a}->{'catorder'} <=> $faqcat{$b}->{'catorder'} } keys %faqcat)
|
||||
{
|
||||
$ret .= "<H2><A HREF=\"readcat.bml?faqcat=$faqcat\">" . LJ::ehtml($faqcat{$faqcat}->{'faqcatname'}) . "</A></H2>\n";
|
||||
$ret .= "<UL>\n";
|
||||
foreach my $faqid (sort { $faqq{$faqcat}->{$a}->{'sortorder'} <=> $faqq{$faqcat}->{$b}->{'sortorder'} } keys %{$faqq{$faqcat}})
|
||||
{
|
||||
my $fe = $faqq{$faqcat}->{$faqid};
|
||||
next unless ($fe->{'question'});
|
||||
my $q = LJ::ehtml($fe->{'question'});
|
||||
$q =~ s/^\s+//; $q =~ s/\s+$//;
|
||||
$q =~ s/\n/<BR>/g;
|
||||
$ret .= "<LI>";
|
||||
if ($ac_edit{'*'} || $ac_edit{$faqcat}) {
|
||||
$ret .= "<A HREF=\"faqedit.bml?id=$faqid\">[edit]</A> ($fe->{'sortorder'}) ";
|
||||
}
|
||||
$ret .= "<B>{$faqid}</B> $q\n";
|
||||
}
|
||||
$ret .= "</UL>\n";
|
||||
}
|
||||
|
||||
return $ret;
|
||||
|
||||
_code?>
|
||||
|
||||
<=body
|
||||
page?><?_c <LJDEP>
|
||||
lib: cgi-bin/ljlib.pl
|
||||
link: htdocs/admin/faq/readcat.bml, htdocs/admin/faq/faqedit.bml
|
||||
</LJDEP> _c?>
|
||||
63
livejournal/htdocs/admin/faq/readcat.bml
Executable file
63
livejournal/htdocs/admin/faq/readcat.bml
Executable file
@@ -0,0 +1,63 @@
|
||||
<?_info
|
||||
nocache=>1
|
||||
_info?><?page
|
||||
title=>Read FAQ
|
||||
body<=
|
||||
|
||||
<CENTER>
|
||||
<A HREF="./"><B>(Back to FAQ Index)</B></A>
|
||||
</CENTER>
|
||||
|
||||
<?_code
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
$ret = "";
|
||||
|
||||
my $qfaqcat = $dbh->quote($FORM{'faqcat'});
|
||||
|
||||
my %faqcat;
|
||||
my %faqq;
|
||||
$sth = $dbh->prepare("SELECT faqcat, faqcatname, catorder FROM faqcat WHERE faqcat=$qfaqcat");
|
||||
$sth->execute;
|
||||
while ($_ = $sth->fetchrow_hashref)
|
||||
{
|
||||
$faqcat{$_->{'faqcat'}} = $_;
|
||||
}
|
||||
|
||||
$sth = $dbh->prepare("SELECT faqid, question, sortorder, faqcat, answer, lastmodtime FROM faq WHERE faqcat=$qfaqcat");
|
||||
$sth->execute;
|
||||
while ($_ = $sth->fetchrow_hashref)
|
||||
{
|
||||
$faqq{$_->{'faqid'}} = $_;
|
||||
}
|
||||
|
||||
foreach my $faqcat (sort { $faqcat{$a}->{'catorder'} <=> $faqcat{$b}->{'catorder'} } keys %faqcat)
|
||||
{
|
||||
$ret .= "<h2>" . LJ::ehtml($faqcat{$faqcat}->{'faqcatname'}) . "</h2>\n";
|
||||
$ret .= "<ul>\n";
|
||||
foreach my $faqid (sort { $faqq{$a}->{'sortorder'} <=> $faqq{$b}->{'sortorder'} } grep { $faqq{$_}->{'faqcat'} eq $faqcat } keys %faqq)
|
||||
{
|
||||
next unless ($faqq{$faqid}->{'question'});
|
||||
BML::note_mod_time($faqq{$faqid}->{'lastmodtime'});
|
||||
my $q = LJ::ehtml($faqq{$faqid}->{'question'});
|
||||
$q =~ s/^\s+//; $q =~ s/\s+$//;
|
||||
$q =~ s!\n!<br />!g;
|
||||
my $a = LJ::ehtml($faqq{$faqid}->{'answer'});
|
||||
$a =~ s/^\s+//; $a =~ s/\s+$//;
|
||||
$a =~ s/\n( +)/"\n" . " "x length($1)/eg;
|
||||
$a =~ s!\n!<br />!g;
|
||||
$ret .= "<p><table bgcolor='#c0c0c0'><tr><td><b>$q</b></td></tr></table>" . LJ::auto_linkify($a);
|
||||
}
|
||||
$ret .= "</ul>\n";
|
||||
}
|
||||
|
||||
return $ret;
|
||||
|
||||
_code?>
|
||||
|
||||
<=body
|
||||
page?><?_c <LJDEP>
|
||||
lib: cgi-bin/ljlib.pl
|
||||
link: htdocs/admin/faq/index.bml
|
||||
</LJDEP> _c?>
|
||||
150
livejournal/htdocs/admin/fileedit/index.bml
Executable file
150
livejournal/htdocs/admin/fileedit/index.bml
Executable file
@@ -0,0 +1,150 @@
|
||||
<?_code
|
||||
|
||||
my ($ret, $sth);
|
||||
|
||||
my $DEF_ROW = 30;
|
||||
my $DEF_COL = 80;
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
my %files = (); # keys: files remote user has access to, value: 1
|
||||
my $INC_DIR = $LJ::BML_INC_DIR_ADMIN || $LJ::BML_INC_DIR || "$LJ::HTDOCS/inc";
|
||||
|
||||
unless (LJ::remote_has_priv($remote, "fileedit", \%files)) {
|
||||
return "You don't have access to edit any files, or you're not logged in.";
|
||||
}
|
||||
|
||||
my $valid_filename = sub
|
||||
{
|
||||
my $filename = shift;
|
||||
return ($filename =~ /^[a-zA-Z0-9-\_]{1,80}$/);
|
||||
};
|
||||
|
||||
my $save_file = sub
|
||||
{
|
||||
my ($filename, $content) = @_;
|
||||
return 0 unless $valid_filename->($filename);
|
||||
|
||||
if ($LJ::FILEEDIT_VIA_DB || $LJ::FILEEDIT_VIA_DB{$filename}) {
|
||||
my $dbh = LJ::get_db_writer();
|
||||
$dbh->do("REPLACE INTO includetext (incname, inctext, updatetime) ".
|
||||
"VALUES (?, ?, UNIX_TIMESTAMP())", undef, $filename, $content);
|
||||
return 0 if $dbh->err;
|
||||
LJ::MemCache::set("includefile:$filename", $content);
|
||||
return 1;
|
||||
}
|
||||
|
||||
open (FILE, ">$INC_DIR/$filename") or return 0;
|
||||
print FILE $content;
|
||||
close FILE;
|
||||
return 1;
|
||||
};
|
||||
|
||||
my $load_file = sub
|
||||
{
|
||||
my ($filename) = @_;
|
||||
return undef unless $valid_filename->($filename);
|
||||
|
||||
my $contents;
|
||||
if ($LJ::FILEEDIT_VIA_DB || $LJ::FILEEDIT_VIA_DB{$filename}) {
|
||||
my $dbh = LJ::get_db_writer();
|
||||
$contents = $dbh->selectrow_array("SELECT inctext FROM includetext WHERE incname=?", undef, $filename);
|
||||
return $contents if defined $contents;
|
||||
}
|
||||
|
||||
open (FILE, "$INC_DIR/$filename") or return undef;
|
||||
while (<FILE>) { $contents .= $_; }
|
||||
close FILE;
|
||||
return $contents;
|
||||
};
|
||||
|
||||
if ($files{'*'})
|
||||
{
|
||||
# if user has access to edit all files, find what those files are!
|
||||
delete $files{'*'};
|
||||
opendir (DIR, $INC_DIR);
|
||||
while (my $file = readdir(DIR)) {
|
||||
$files{$file} = 1;
|
||||
}
|
||||
closedir (DIR);
|
||||
}
|
||||
|
||||
## get rid of files that don't match our safe pattern
|
||||
{
|
||||
my @del;
|
||||
foreach my $k (keys %files) {
|
||||
push @del, $k
|
||||
unless $valid_filename->($k);
|
||||
}
|
||||
foreach my $k (@del) { delete $files{$k}; }
|
||||
}
|
||||
|
||||
my $mode = $FORM{'mode'};
|
||||
unless ($mode) {
|
||||
$mode = $FORM{'file'} ? "edit" : "pick";
|
||||
}
|
||||
|
||||
if ($mode eq "pick")
|
||||
{
|
||||
$ret .= "<FORM METHOD=GET>\n";
|
||||
$ret .= "Pick file to edit: <SELECT NAME=\"file\">";
|
||||
foreach my $file (sort keys %files) {
|
||||
$ret .= "<OPTION VALUE=\"$file\">$file\n";
|
||||
}
|
||||
$ret .= "</SELECT> <INPUT TYPE=SUBMIT VALUE=\"load...\"><BR>";
|
||||
$ret .= "Wordwrap? <INPUT TYPE=CHECKBOX VALUE=1 NAME=w> ";
|
||||
$ret .= "Rows: <INPUT SIZE=3 NAME=r VALUE=$DEF_ROW> ";
|
||||
$ret .= "Cols: <INPUT SIZE=3 NAME=c VALUE=$DEF_COL> ";
|
||||
$ret .= "</FORM>";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
my $file = $FORM{'file'};
|
||||
unless ($files{$file}) {
|
||||
return "<B>ERROR!</B> you don't have access to this document.";
|
||||
}
|
||||
|
||||
if ($mode eq "edit")
|
||||
{
|
||||
$ret .= "<B>Editing:</B> <tt>$file</tt><P>";
|
||||
my $contents = $load_file->($file);
|
||||
|
||||
return "<B>Error:</B> Couldn't open file"
|
||||
unless defined $contents;
|
||||
|
||||
my $r = ($FORM{'r'}+0) || $DEF_ROW;
|
||||
my $c = ($FORM{'c'}+0) || $DEF_COL;
|
||||
my $wrap = $FORM{'w'} ? "SOFT" : "OFF";
|
||||
|
||||
$ret .= "<FORM METHOD=POST>\n";
|
||||
$ret .= "<INPUT TYPE=HIDDEN NAME=mode VALUE=\"save\">";
|
||||
$ret .= "<INPUT TYPE=HIDDEN NAME=file VALUE=\"$file\">";
|
||||
$ret .= "<TEXTAREA ROWS=$r COLS=$c WRAP=$wrap NAME=contents>";
|
||||
$ret .= BML::eall($contents);
|
||||
$ret .= "</TEXTAREA><P><INPUT TYPE=SUBMIT VALUE=\"Save\"> (no undo.. are you sure?)";
|
||||
$ret .= "</FORM>\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
if ($mode eq "save")
|
||||
{
|
||||
unless (LJ::did_post()) {
|
||||
return "<b>Error:</b> requires post";
|
||||
}
|
||||
|
||||
$ret .= "<B>Saving:</B> <tt>$file</tt><p>";
|
||||
if ($save_file->($file, $FORM{'contents'})) {
|
||||
$ret .= "saved.";
|
||||
} else {
|
||||
$ret .= "<b>Error saving</b>";
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
return "unknown mode";
|
||||
|
||||
_code?><?_c <LJDEP>
|
||||
lib: cgi-bin/ljlib.pl
|
||||
form: htdocs/admin/fileedit/index.bml
|
||||
post: htdocs/admin/fileedit/index.bml
|
||||
</LJDEP> _c?>
|
||||
170
livejournal/htdocs/admin/memcache.bml
Executable file
170
livejournal/htdocs/admin/memcache.bml
Executable file
@@ -0,0 +1,170 @@
|
||||
<?_code
|
||||
{
|
||||
#line 3
|
||||
use strict;
|
||||
no strict 'refs';
|
||||
use vars qw(%GET);
|
||||
use Data::Dumper;
|
||||
use Time::HiRes ();
|
||||
|
||||
my $u = LJ::get_remote();
|
||||
return "You must be logged in to view this tool." unless $u;
|
||||
return "You don't have 'siteadmin' priv." unless LJ::check_priv($u, "siteadmin");
|
||||
|
||||
my $prev_hits = $u ? LJ::MemCache::get([$u->{'userid'},"mcrate:$u->{'userid'}"]) : undef;
|
||||
|
||||
my $ret;
|
||||
|
||||
my $mode = $GET{'mode'};
|
||||
if ($GET{'host'}) {
|
||||
$mode ||= "host";
|
||||
}
|
||||
$mode ||= "overview";
|
||||
|
||||
$ret .= "<div class='topbar'>[<a href='memcache.bml'>Overview</a>]\n";
|
||||
|
||||
if ($mode eq "overview") {
|
||||
$ret .= <<"END_TOP";
|
||||
</div>
|
||||
<h1>Memory Cache Overview</h1>
|
||||
<table border='1' cellpadding='5'>
|
||||
<tr><th>Host</th><th>Hit Rate</th><th>Curr/Max Size</th><th><span title='Utilization'>Utlz %</span></th><th>Uptime</th><th>Version</th></tr>
|
||||
END_TOP
|
||||
}
|
||||
|
||||
my %now_hits;
|
||||
if ($prev_hits) { %now_hits = %$prev_hits; }
|
||||
|
||||
my ($tot_hits, $tot_misses) = ();
|
||||
|
||||
foreach my $entry (@LJ::MEMCACHE_SERVERS) {
|
||||
my $host = ref $entry ? $entry->[0] : $entry;
|
||||
next if $mode eq "host" && $host ne $GET{'host'};
|
||||
|
||||
LJ::MemCache::forget_dead_hosts();
|
||||
my $sock = Cache::Memcached::sock_to_host($host);
|
||||
|
||||
my $t1 = Time::HiRes::time();
|
||||
|
||||
my $log;
|
||||
my %stat;
|
||||
my @cmds = ("", "malloc", "items", "slabs");
|
||||
my $cmd;
|
||||
if ($sock) {
|
||||
while (defined($cmd = shift @cmds)) {
|
||||
my $realcmd = "stats" . ($cmd ? " $cmd" : "");
|
||||
$log .= "<b>$realcmd</b>\n";
|
||||
foreach (LJ::MemCache::run_command($sock, "$realcmd\r\n")) {
|
||||
last if $_ eq "END\r\n";
|
||||
$log .= $_;
|
||||
next if $cmd eq "maps";
|
||||
if (/^STAT (\S+) (\S+)/) {
|
||||
$stat{$cmd}{$1} = $2;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $t2 = Time::HiRes::time();
|
||||
|
||||
my $cpu = 0;
|
||||
foreach my $key (qw(rusage_user rusage_system)) {
|
||||
my $sec = $stat{''}{$key};
|
||||
$sec =~ s/:/\./;
|
||||
$cpu += $sec;
|
||||
#$ret .= "Host $host was $stat{''}{$key} = $sec, cpu = $cpu<br />\n";
|
||||
}
|
||||
|
||||
$now_hits{$host} = [ $stat{''}{'get_hits'}, $stat{''}{'get_misses'}, $cpu ];
|
||||
|
||||
my $hit_rate = sprintf("%0.02f%%", $stat{''}{'get_hits'}/($stat{''}{'get_hits'}+$stat{''}{'get_misses'}||1)*100);
|
||||
|
||||
if ($mode eq "overview") {
|
||||
$ret .= "<tr><td><a href='memcache.bml?host=$host'>$host</a></td>\n";
|
||||
$ret .= "<td>$hit_rate";
|
||||
if ($prev_hits && $prev_hits->{$host}) {
|
||||
my $nh = $now_hits{$host};
|
||||
my $ph = $prev_hits->{$host};
|
||||
|
||||
my $new_hits = $now_hits{$host}[0] - $prev_hits->{$host}[0];
|
||||
my $new_misses = $now_hits{$host}[1] - $prev_hits->{$host}[1];
|
||||
$tot_hits += $new_hits;
|
||||
$tot_misses += $new_misses;
|
||||
my $new_whatev = $new_hits + $new_misses;
|
||||
my $new_rate = $new_hits / ($new_whatev || 1);
|
||||
|
||||
my $cpu = sprintf("%0.6f", $nh->[2] - $ph->[2]);
|
||||
$ret .= sprintf(" [%0.02f%% {$new_whatev} $cpu]", $new_rate * 100);
|
||||
}
|
||||
$ret .= sprintf(" %0.02f", $t2-$t1);
|
||||
$ret .= "</td>";
|
||||
my $gb_used = ($stat{'malloc'}{'mmapped_space'} + $stat{'malloc'}{'arena_size'}) / (1024*1024*1024);
|
||||
my $gb_max = $stat{''}{'limit_maxbytes'} / (1024*1024*1024);
|
||||
if ($gb_used >= $gb_max) {
|
||||
$ret .= sprintf("<td align='center'>%0.01fG</td>", $gb_max);
|
||||
} else {
|
||||
$ret .= sprintf("<td>%0.02f/%0.01fG (%0.02f%%)</td>", $gb_used, $gb_max, $gb_used*100/($gb_max||1));
|
||||
}
|
||||
|
||||
my $utiliz = $stat{''}{'bytes'} /
|
||||
(($stat{'malloc'}{'mmapped_space'} + $stat{'malloc'}{'arena_size'}) || 1);
|
||||
$ret .= sprintf("<td>%0.02f%%</td>", $utiliz*100);
|
||||
|
||||
my $up = $stat{''}{'uptime'};
|
||||
my $upstring;
|
||||
foreach my $u ([86400,"d"],[3600,"h"],[60,"m"],[1,"s"]) {
|
||||
if ($up / $u->[0] > 1) {
|
||||
my $v = int($up / $u->[0]);
|
||||
$upstring .= "${v}$u->[1] ";
|
||||
$up -= $v * $u->[0];
|
||||
}
|
||||
}
|
||||
$ret .= "<td>$upstring</td>";
|
||||
$ret .= "<td>$stat{''}{'version'}</td>";
|
||||
$ret .= "</tr>";
|
||||
}
|
||||
|
||||
if ($mode eq "host" && $host eq $GET{'host'}) {
|
||||
$ret .= "[<a href='memcache.bml?host=$host&mode=raw'>Raw Data</a>]</div>";
|
||||
$ret .= "<h1>Details for $host</h1>";
|
||||
|
||||
$ret .= "<h2>Slab classes</h2>";
|
||||
$ret .= "<table border='1' cellpadding='2'>";
|
||||
$ret .= "<tr><th>class</th><th>size</th><th>used</th><th>total</th><th colspan='2'>free</th><th>pages</th><th>max age</th></tr>\n";
|
||||
foreach my $cls (0..31) {
|
||||
my $size = $stat{'slabs'}{"$cls:chunk_size"};
|
||||
next unless $size;
|
||||
$ret .= "<tr><td>$cls</td>"
|
||||
. join('', map { "<td>" . $stat{'slabs'}{"$cls:$_"} . "</td>" }
|
||||
qw(chunk_size used_chunks total_chunks free_chunks free_chunks_end total_pages));
|
||||
my $age = $stat{'items'}{"items:$cls:age"};
|
||||
$ret .= "<td>$age</td>";
|
||||
$ret .= "</tr>";
|
||||
}
|
||||
$ret .= "</table>\n";
|
||||
|
||||
}
|
||||
|
||||
if ($mode eq "raw" && $host eq $GET{'host'}) {
|
||||
$ret .= "[<a href='memcache.bml?host=$host'>Host Stats</a>]</div>";
|
||||
$ret .= "<h1>Raw data for $host</h1>";
|
||||
$ret .= "<pre>$log</pre>";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
LJ::MemCache::set([$u->{'userid'},"mcrate:$u->{'userid'}"], \%now_hits)
|
||||
if $u;
|
||||
|
||||
if ($mode eq "overview") {
|
||||
$ret .= "</table>\n";
|
||||
|
||||
my $new_whatev = $tot_hits + $tot_misses;
|
||||
my $new_rate = $tot_hits / ($new_whatev || 1);
|
||||
$ret .= sprintf("Global [%0.02f%% {$new_whatev}]", $new_rate * 100);
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
_code?>
|
||||
|
||||
275
livejournal/htdocs/admin/memcache_view.bml
Executable file
275
livejournal/htdocs/admin/memcache_view.bml
Executable file
@@ -0,0 +1,275 @@
|
||||
<html>
|
||||
<head><title>Memcache view</title>
|
||||
<body>
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%GET %POST);
|
||||
use Data::Dumper;
|
||||
my $ret;
|
||||
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
return "<b>Error:</b> You don't have access to viewing memcache info."
|
||||
unless (LJ::check_priv($remote, "siteadmin", "memcacheview"));
|
||||
|
||||
return "<b>Error:</b> No memcache servers defined."
|
||||
unless @LJ::MEMCACHE_SERVERS;
|
||||
|
||||
my $uid = sub {
|
||||
my $u = LJ::load_user(shift);
|
||||
return $u ? $u->{'userid'} : "";
|
||||
};
|
||||
my $cuid = sub {
|
||||
my $u = LJ::load_user(shift);
|
||||
return $u ? "$u->{'clusterid'}:$u->{'userid'}" : "";
|
||||
};
|
||||
|
||||
# key: unique prefix of a memcache key
|
||||
# value: number n, means the n-th component of the key when
|
||||
# split by ':' is the hash key. 0 means no hash key.
|
||||
# the default, when absent from this hash, is "n=2 if the 2nd component
|
||||
# is a number".
|
||||
|
||||
my %MEMC_HASHKEYS = (
|
||||
'uidof:' => 0,
|
||||
'talksubject:' => 3,
|
||||
'talkbody:' => 3,
|
||||
'logtext:' => 3,
|
||||
's1pubstyc:' => 0,
|
||||
'popsyn:' => 0,
|
||||
'rate_eperr:' => 0,
|
||||
'rate:' => 0,
|
||||
'ml.' => 0,
|
||||
);
|
||||
|
||||
my $get_hashkey = sub {
|
||||
my $key = shift;
|
||||
return undef unless $key;
|
||||
|
||||
my $hk;
|
||||
my $component;
|
||||
|
||||
foreach (keys %MEMC_HASHKEYS) {
|
||||
if ($key =~ /^$_/) {
|
||||
$component = $MEMC_HASHKEYS{$_};
|
||||
}
|
||||
}
|
||||
return undef if defined ($component) and $component == 0;
|
||||
my $sep = ':';
|
||||
$sep = '.' if $key =~ /userpic\./; #special case
|
||||
my @els = split (/\Q$sep\E/, $key);
|
||||
$hk = $els[defined($component) ? $component-1 : 2-1];
|
||||
$hk = undef
|
||||
unless defined($component) || int($hk)==$hk;
|
||||
return $hk;
|
||||
};
|
||||
|
||||
my $display = sub {
|
||||
my ($key, $val) = @_;
|
||||
|
||||
# first, transform array->hash if necessary
|
||||
$val = LJ::MemCache::array_to_hash("user", $val)
|
||||
if $key =~ /^user:/
|
||||
or $key =~ /^userid:/;
|
||||
|
||||
# blot out passwords
|
||||
if (ref $val eq 'HASH' && defined($val->{'password'})) {
|
||||
$val->{'password'} = '*' x 8;
|
||||
}
|
||||
|
||||
# unpack packed data
|
||||
if ($key =~ /^talk2:/) {
|
||||
my $newval;
|
||||
my $n = (length($val) - 1) / 16;
|
||||
for (my $i=0; $i<$n; $i++) {
|
||||
my ($f1, $par, $poster, $time) = unpack("NNNN",substr($val,$i*16+1,16));
|
||||
my $state = chr($f1 & 255);
|
||||
my $talkid = $f1 >> 8;
|
||||
$newval->{$talkid} = {
|
||||
talkid => $talkid,
|
||||
state => $state,
|
||||
posterid => $poster,
|
||||
datepost => LJ::mysql_time($time),
|
||||
parenttalkid => $par,
|
||||
};
|
||||
}
|
||||
$val = [substr($val,0,1), $newval];
|
||||
}
|
||||
|
||||
if ($key =~ /^log2:/) {
|
||||
my $item = {};
|
||||
@$item{'posterid', 'eventtime', 'logtime', 'allowmask', 'ditemid'} = unpack("NNNNN", $val);
|
||||
$item->{'security'} = ($item->{'allowmask'} == 0 ? 'private' :
|
||||
($item->{'allowmask'} == 2**31 ? 'public' : 'usemask'));
|
||||
@$item{'jitemid', 'anum'} = ($item->{'ditemid'} >> 8, $item->{'ditemid'} % 256);
|
||||
$item->{'eventtime'} = LJ::mysql_time($item->{'eventtime'}, 1);
|
||||
$item->{'logtime'} = LJ::mysql_time($item->{'logtime'}, 1);
|
||||
$val = $item;
|
||||
}
|
||||
|
||||
if ($key =~ /^log2lt:/) {
|
||||
my $items = [];
|
||||
my $ver = substr($val, 0, 1);
|
||||
my $offset = {1=>1, 2=>5, 3=>5}->{$ver};
|
||||
my $newval;
|
||||
|
||||
push @$newval, $ver;
|
||||
push @$newval, unpack("N", substr($val, 1, 4))
|
||||
if $ver>=2;
|
||||
|
||||
my $n = (length($val) - $offset )/20;
|
||||
for (my $i=0; $i<$n; $i++) {
|
||||
my ($posterid, $eventtime, $rlogtime, $allowmask, $ditemid) =
|
||||
unpack("NNNNN", substr($val, $i*20+$offset, 20));
|
||||
$eventtime = LJ::mysql_time($eventtime, 1);
|
||||
my $security = $allowmask == 0 ? 'private' :
|
||||
($allowmask == 2**31 ? 'public' : 'usemask');
|
||||
my ($jitemid, $anum) = ($ditemid >> 8, $ditemid % 256);
|
||||
my $item = {};
|
||||
@$item{'posterid','eventtime','rlogtime','allowmask','ditemid',
|
||||
'security', 'jitemid', 'anum'} =
|
||||
($posterid, $eventtime, $rlogtime, $allowmask,
|
||||
$ditemid, $security, $jitemid, $anum);
|
||||
push @$items, $item;
|
||||
}
|
||||
push @$newval, $items;
|
||||
$val = $newval;
|
||||
}
|
||||
|
||||
if ($key =~ /^fgrp:/) {
|
||||
my $newval = [];
|
||||
my $ver = shift @$val;
|
||||
push @$newval, $ver;
|
||||
foreach(@$val) {
|
||||
push @$newval, LJ::MemCache::array_to_hash("fgrp", [$ver, @$_]);
|
||||
}
|
||||
$val = $newval;
|
||||
}
|
||||
|
||||
if ($key =~ /^upicinf:(\d+)$/) {
|
||||
my $userid = $1;
|
||||
my ($ver, $picstr, $kwstr) = @$val;
|
||||
my $info = {
|
||||
'version' => $ver,
|
||||
'pic' => {},
|
||||
'kw' => {},
|
||||
};
|
||||
|
||||
while (length $picstr >= 7) {
|
||||
my $pic = { userid => $userid };
|
||||
($pic->{picid},
|
||||
$pic->{width}, $pic->{height},
|
||||
$pic->{state}) = unpack "NCCA", substr($picstr, 0, 7, '');
|
||||
$info->{pic}{$pic->{picid}} = $pic;
|
||||
}
|
||||
|
||||
my ($pos, $nulpos);
|
||||
$pos = $nulpos = 0;
|
||||
while (($nulpos = index($kwstr, "\0", $pos)) > 0) {
|
||||
my $kw = substr($kwstr, $pos, $nulpos-$pos);
|
||||
my $id = unpack("N", substr($kwstr, $nulpos+1, 4));
|
||||
$pos = $nulpos + 5; # skip NUL + 4 bytes.
|
||||
$info->{kw}{$kw} = $info->{pic}{$id} if $info;
|
||||
}
|
||||
$val = $info;
|
||||
}
|
||||
|
||||
if ($key =~ /^friends:/) {
|
||||
my $ver = substr($val, 0, 1, '');
|
||||
my $packfmt = "NH6H6NC";
|
||||
my $packlen = 15;
|
||||
my @cols = qw(friendid fgcolor bgcolor groupmask showbydefault);
|
||||
my %friends;
|
||||
|
||||
while (length($val) >= $packlen) {
|
||||
my @row = unpack($packfmt, substr($val, 0, $packlen, ''));
|
||||
|
||||
# add "#" to beginning of colors
|
||||
$row[$_] = "\#$row[$_]" foreach 1..2;
|
||||
|
||||
# turn unpacked row into hashref
|
||||
my $fid = $row[0];
|
||||
my $idx = 1;
|
||||
foreach my $col (@cols[1..$#cols]) {
|
||||
$friends{$fid}->{$col} = $row[$idx];
|
||||
$idx++;
|
||||
}
|
||||
}
|
||||
$val = [$ver, \%friends];
|
||||
}
|
||||
|
||||
if ($key =~ /^tu:/) {
|
||||
$val = unpack("N", $val);
|
||||
}
|
||||
# just in case this remains a packed scalar
|
||||
if (not ref $val) {
|
||||
$val =~ s/([\x00-\x1f])/sprintf("\\x%02x", $1)/eg;
|
||||
}
|
||||
$ret .= "<b>Data: </b>";
|
||||
|
||||
my $dumper = Data::Dumper->new([$val],["Value"]);
|
||||
$dumper->Terse(1);
|
||||
$dumper->Indent(2);
|
||||
my $d = $dumper->Dump();
|
||||
|
||||
$ret.= "<pre>" . LJ::ehtml($d) . "</pre>";
|
||||
|
||||
return;
|
||||
};
|
||||
|
||||
|
||||
if ($POST{'query'}) {
|
||||
foreach my $key (split(/\r\n/, $POST{'query'})) {
|
||||
|
||||
next unless $key =~ /\S/;
|
||||
# shortcuts
|
||||
$key =~ s/(##)(\w+)/$cuid->($2)/eg;
|
||||
$key =~ s/(#)(\w+)/$uid->($2)/eg;
|
||||
$key =~ s!\((\d+)\)!int($1/256)!eg;
|
||||
|
||||
my $sock = LJ::MemCache::_get_sock($key);
|
||||
$ret .= "<p><b>Key: </b>$key<br />";
|
||||
|
||||
unless ($sock) {
|
||||
$ret .= "<b>Error: </b>Could not connect to server<br /></p>";
|
||||
next;
|
||||
}
|
||||
|
||||
if ($POST{'sock'}) {
|
||||
$ret .= "<b>Socket:</b> $sock<br />";
|
||||
}
|
||||
|
||||
my $hashkey = $get_hashkey->($key);
|
||||
if ($hashkey) {
|
||||
$ret .= "<b>Hashkey:</b> $hashkey<br />";
|
||||
}
|
||||
my $pars = defined($hashkey) ? [$hashkey, $key] : $key;
|
||||
my $val = LJ::MemCache::get($pars);
|
||||
unless (defined $val) {
|
||||
$ret .= "<b>Data:</b> not found</br ></p>";
|
||||
next;
|
||||
}
|
||||
$display->($key, $val);
|
||||
$ret .= "</p>";
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
$ret .= "<p>Enter your memcache query(-ies) below.</p>";
|
||||
$ret .= '<p>Here\'s the <a href="http://cvs.livejournal.org/browse.cgi/livejournal/doc/raw/memcache-keys.txt?rev=.&content-type=text/x-cvsweb-markup">reference</a> of key names.</p>';
|
||||
$ret .= "<p>Shortcuts: <blockquote>#username -> userid<br /> ##username -> cid:userid<br />(number) -> number/256 </blockquote></p>";
|
||||
|
||||
$ret .= '<form method="post" action="memcache_view.bml">';
|
||||
$ret .= "<textarea name=query rows=3 cols=60 wrap=off></textarea> ";
|
||||
$ret .= "<p>" . LJ::html_check({ 'type' => 'check', 'name' => 'sock', 'id' => 'sock' });
|
||||
$ret .= "<label for='sock'>Show host/port per key.</label></p>";
|
||||
|
||||
$ret .= "<input type='submit' value='Submit'>";
|
||||
return $ret;
|
||||
|
||||
|
||||
_code?>
|
||||
</body>
|
||||
</html>
|
||||
129
livejournal/htdocs/admin/mysql_status.bml
Executable file
129
livejournal/htdocs/admin/mysql_status.bml
Executable file
@@ -0,0 +1,129 @@
|
||||
<?_code
|
||||
|
||||
my $format = $FORM{'format'} || "html";
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return"<b>Error:</b> You don't have access to administer databases."
|
||||
unless (LJ::check_priv($remote, "siteadmin", "mysqlstatus"));
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
if ($format eq "text") {
|
||||
BML::set_content_type("text/plain");
|
||||
}
|
||||
|
||||
my ($sth, $ret);
|
||||
|
||||
if ($format eq "html") {
|
||||
$ret .= "<style>\ntd { font-family: arial; font-size: 11px };\n</style>\n";
|
||||
}
|
||||
|
||||
my @modes = qw(status variables tables);
|
||||
my $mode = $FORM{'mode'} || "status";
|
||||
foreach my $m (@modes) {
|
||||
if ($mode eq $m) {
|
||||
$mode = $m;
|
||||
$ret .= "<b>[ $mode ]</b> " if ($format eq "html");
|
||||
} else {
|
||||
if ($format eq "html") {
|
||||
$ret .= "<b>[</b> <a href=\"" . BML::self_link({'mode' => $m});
|
||||
$ret .= "\">$m</a> <b>]</b> ";
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($format eq "html") {
|
||||
$ret .= "<p>Or, view <a href=\"mysql_status.bml?mode=$mode&format=text\">as text</a>.<p>";
|
||||
}
|
||||
|
||||
if ($mode eq "status")
|
||||
{
|
||||
$sth = $dbh->prepare("SHOW STATUS");
|
||||
$sth->execute;
|
||||
my %s;
|
||||
while (my ($k, $v) = $sth->fetchrow_array) {
|
||||
$s{$k} = $v;
|
||||
}
|
||||
|
||||
$sth = $dbh->prepare("SHOW STATUS");
|
||||
$sth->execute;
|
||||
if ($format eq "html") {
|
||||
$ret .= "<table cellpadding=2 border=1 cellspacing=1>";
|
||||
}
|
||||
while (my ($k, $v) = $sth->fetchrow_array) {
|
||||
my $delta = $v - $s{$k};
|
||||
if ($delta == 0) {
|
||||
$delta = "";
|
||||
} elsif ($delta > 0) {
|
||||
$delta = "+$delta";
|
||||
} else {
|
||||
$delta = "-$delta";
|
||||
}
|
||||
if ($format eq "html") {
|
||||
$ret .= "<tr><td><b>$k</b></td><td>$v</td><td>$delta</td></tr>\n";
|
||||
} elsif ($format eq "text") {
|
||||
$ret .= "$k,$v,$delta\n";
|
||||
}
|
||||
}
|
||||
$ret .= "</table>\n" if ($format eq "html");
|
||||
return $ret;
|
||||
}
|
||||
|
||||
if ($mode eq "variables")
|
||||
{
|
||||
$sth = $dbh->prepare("SHOW VARIABLES");
|
||||
$sth->execute;
|
||||
|
||||
$ret .= "<table cellpadding=2 border=1 cellspacing=1>" if ($format eq "html");
|
||||
while (my ($k, $v) = $sth->fetchrow_array) {
|
||||
if ($format eq "html") {
|
||||
$ret .= "<tr><td><b>$k</b></td><td>$v</td></tr>\n";
|
||||
} else {
|
||||
$ret .= "$k,$v\n";
|
||||
}
|
||||
}
|
||||
$ret .= "</table>\n" if ($format eq "html");
|
||||
return $ret;
|
||||
}
|
||||
|
||||
if ($mode eq "tables")
|
||||
{
|
||||
$sth = $dbh->prepare("SHOW TABLE STATUS");
|
||||
$sth->execute;
|
||||
|
||||
if ($format eq "html") {
|
||||
$ret .= "<table cellpadding=2 border=1 cellspacing=1>";
|
||||
$ret .= "<tr>";
|
||||
}
|
||||
my @cols = @{$sth->{'NAME'}};
|
||||
foreach (@cols) {
|
||||
if ($format eq "html") {
|
||||
$ret .= "<td><b>$_</b></td>";
|
||||
} else {
|
||||
$ret .= "$_,";
|
||||
}
|
||||
}
|
||||
if ($format eq "html") {
|
||||
$ret .= "</tr>\n";
|
||||
} else {
|
||||
$ret .= "\n";
|
||||
}
|
||||
while (my $t = $sth->fetchrow_hashref) {
|
||||
$ret .= "<tr>" if ($format eq "html");
|
||||
foreach my $c (@cols) {
|
||||
if ($format eq "html") {
|
||||
$ret .= "<td>$t->{$c}</td>";
|
||||
} elsif ($format eq "text") {
|
||||
$ret .= "$t->{$c},";
|
||||
}
|
||||
}
|
||||
if ($format eq "html") {
|
||||
$ret .= "</tr>";
|
||||
} elsif ($format eq "text") {
|
||||
$ret .= "\n";
|
||||
}
|
||||
}
|
||||
$ret .= "</table>\n" if ($format eq "html");
|
||||
return $ret;
|
||||
}
|
||||
|
||||
_code?>
|
||||
338
livejournal/htdocs/admin/priv/index.bml
Executable file
338
livejournal/htdocs/admin/priv/index.bml
Executable file
@@ -0,0 +1,338 @@
|
||||
<html><head>
|
||||
<meta name="robots" content="noindex, nofollow, noarchive" />
|
||||
<meta name="googlebot" content="nosnippet" />
|
||||
<title>Privilege Management</title>
|
||||
</head><body>
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%FORM);
|
||||
|
||||
my $dbh = LJ::get_db_writer;
|
||||
|
||||
my ($sth, $ret);
|
||||
my $mode = $FORM{'mode'};
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
LJ::load_user_privs($remote, 'admin') if $remote;
|
||||
|
||||
my @privs;
|
||||
my %priv;
|
||||
my %pcode2id;
|
||||
$sth = $dbh->prepare("SELECT prlid, privcode, privname, des, is_public, scope FROM priv_list ORDER BY privcode");
|
||||
$sth->execute;
|
||||
while ($_ = $sth->fetchrow_hashref) {
|
||||
push @privs, $_;
|
||||
$priv{$_->{'prlid'}} = $_;
|
||||
$pcode2id{$_->{'privcode'}} = $_->{'prlid'};
|
||||
}
|
||||
|
||||
if (LJ::did_post()) {
|
||||
return "<p><b>ERROR:</b> Invalid form submission" unless LJ::check_form_auth();
|
||||
}
|
||||
|
||||
unless ($mode)
|
||||
{
|
||||
if ($FORM{'user'}) { $mode = "viewuser"; }
|
||||
elsif ($FORM{'priv'}) { $mode = "viewpriv"; }
|
||||
}
|
||||
|
||||
if ($FORM{'devmode'}) {
|
||||
return "not in dev mode" unless $LJ::IS_DEV_SERVER;
|
||||
my $userid = $remote->{userid};
|
||||
if ($dbh->do("INSERT INTO priv_map (userid, prlid, arg) SELECT ?, prlid, ? FROM priv_list WHERE privcode=?",
|
||||
undef, $userid, $FORM{arg}, $FORM{priv})) {
|
||||
LJ::statushistory_add($dbh, $userid, $userid, "privadd", "DEVMODE Granting: \"$FORM{priv}\" with arg \"$FORM{arg}\"");
|
||||
return "done.";
|
||||
} else {
|
||||
return "fail.";
|
||||
}
|
||||
}
|
||||
|
||||
unless ($mode)
|
||||
{
|
||||
$ret .= "<h1>Privilege Management</h1>\n";
|
||||
$ret .= "<form method='get' action='index.bml'>";
|
||||
$ret .= "<p>View all privileges of user <input name='user' size='15' /> <input type='submit' value=\"Load\" /></p></form>";
|
||||
|
||||
$ret .= "<p>Or, show all users with privilege:</p><dl>";
|
||||
foreach my $priv (@privs) {
|
||||
my ($des, $args) = split(/arg=/, $priv->{'des'});
|
||||
$ret .= "<dt><strong><a href='./?priv=$priv->{'privcode'}'>$priv->{'privcode'}</a>: $priv->{'privname'}</strong>";
|
||||
$ret .= " <i>(Site Specific)</i>" if $priv->{'scope'} eq 'local';
|
||||
$ret .= "</dt>";
|
||||
$ret .= "<dd>$des\n";
|
||||
$ret .= "<br /><strong>Argument:</strong> $args" if $args;
|
||||
$ret .= "</dd>";
|
||||
}
|
||||
$ret .= "</dl>";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
|
||||
# Returns true if the remote user can grant the given priv
|
||||
sub remote_can_grant
|
||||
{
|
||||
my ($remote, $priv, $arg) = @_;
|
||||
return 0 unless defined $priv;
|
||||
return LJ::check_priv($remote, 'admin', $priv) || LJ::check_priv($remote, 'admin', '*') || LJ::check_priv($remote, 'admin', "$priv/$arg");
|
||||
}
|
||||
|
||||
if ($mode eq "userchange" || $mode eq "privchange")
|
||||
{
|
||||
unless (LJ::did_post()) {
|
||||
return "<p><b>Error:</b> requires post</p>";
|
||||
}
|
||||
|
||||
unless ($FORM{'submit:refresh'}) {
|
||||
foreach my $key (keys %FORM) {
|
||||
if ($key =~ /^revoke:(\d+):(\d+)$/) {
|
||||
my $prmid = $1;
|
||||
my $del_userid1 = $2;
|
||||
my $sth = $dbh->prepare("SELECT userid, prlid, arg FROM priv_map WHERE prmid=$prmid");
|
||||
$sth->execute;
|
||||
my ($del_userid2, $prlid, $arg) = $sth->fetchrow_array;
|
||||
|
||||
unless (remote_can_grant($remote, $priv{$prlid}->{'privcode'}, $arg)) {
|
||||
$ret .= "ERROR: Invalid access to remove priv $priv{$prlid}->{'privcode'}.<br />";
|
||||
} else {
|
||||
if ($del_userid1 && $del_userid1 == $del_userid2)
|
||||
{
|
||||
$dbh->do("DELETE FROM priv_map WHERE prmid=$prmid");
|
||||
my $privcode = $priv{$prlid}->{'privcode'};
|
||||
LJ::statushistory_add($dbh, $del_userid1, $remote->{'userid'}, "privdel",
|
||||
"Denying: \"$privcode\" with arg \"$arg\"");
|
||||
$ret .= "Privilege removed.<br />\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($FORM{'grantpriv'}) {
|
||||
my $u = LJ::load_user($FORM{'user'});
|
||||
return "ERROR: Invalid user." unless $u;
|
||||
my $userid = $u->{'userid'};
|
||||
my $qpriv = $FORM{'grantpriv'}+0;
|
||||
my $privcode = $priv{$qpriv}->{'privcode'};
|
||||
my $arg = $FORM{'arg'};
|
||||
|
||||
if ($privcode) {
|
||||
if (remote_can_grant($remote, $privcode, $arg)) {
|
||||
if (LJ::check_priv($u, $privcode, $arg)) {
|
||||
$ret .= "ERROR: User already has specified priv <b>$privcode $arg</b>.<br />";
|
||||
} else {
|
||||
my $qarg = $dbh->quote($arg);
|
||||
$dbh->do("INSERT INTO priv_map (prmid, userid, prlid, arg) VALUES (NULL, $userid, $qpriv, $qarg)");
|
||||
LJ::statushistory_add($dbh, $userid, $remote->{'userid'}, "privadd", "Granting: \"$privcode\" with arg \"$arg\"");
|
||||
$ret .= "Privilege <b>$privcode $arg</b> granted.<br />\n";
|
||||
}
|
||||
} else {
|
||||
$ret .= "ERROR: You don't have access to grant <b>$privcode $arg</b>.<br />\n";
|
||||
}
|
||||
} else {
|
||||
$ret .= "ERROR: Unknown privilege.<br />\n";
|
||||
}
|
||||
}
|
||||
if ($FORM{'grantuser'}) {
|
||||
my $u = LJ::load_user($FORM{'grantuser'});
|
||||
return "ERROR: Invalid user." unless $u;
|
||||
my $userid = $u->{'userid'};
|
||||
my $privid = $pcode2id{$FORM{'priv'}};
|
||||
my $arg = $FORM{'arg'};
|
||||
my $qarg = $dbh->quote($arg);
|
||||
my $privcode = $priv{$privid}->{'privcode'};
|
||||
if ($privcode) {
|
||||
if (remote_can_grant($remote, $privcode, $arg)) {
|
||||
if (LJ::check_priv($u, $privcode, $arg)) {
|
||||
$ret .= "ERROR: User already has specified priv <b>$privcode $arg</b>.<br />";
|
||||
}
|
||||
elsif ($userid && $privid) {
|
||||
my $qarg = $dbh->quote($FORM{'arg'});
|
||||
$dbh->do("INSERT INTO priv_map (prmid, userid, prlid, arg) VALUES (NULL, $userid, $privid, $qarg)");
|
||||
LJ::statushistory_add($dbh, $userid, $remote->{'userid'}, "privadd", "Granting: \"$privcode\" with arg \"$FORM{'arg'}\"");
|
||||
$ret .= "Privilege added.<br />\n";
|
||||
}
|
||||
else {
|
||||
my $euser = LJ::ehtml($FORM{'grantuser'});
|
||||
unless ($userid) {
|
||||
$ret .= "ERROR: cannot grant priv to non-existent user <b>$euser</b><br />";
|
||||
}
|
||||
else { $ret .= "privid is 0!<br />"; }
|
||||
}
|
||||
} else {
|
||||
$ret .= "ERROR: You don't have access to grant <B>$privcode</B> with argument '$arg'.<br />\n";
|
||||
}
|
||||
} else {
|
||||
$ret .= "ERROR: Unknown privilege.<br />\n";
|
||||
}
|
||||
} # end if grantuser
|
||||
}
|
||||
|
||||
if ($mode eq "userchange") { $mode = "viewuser"; }
|
||||
if ($mode eq "privchange") { $mode = "viewpriv"; }
|
||||
}
|
||||
|
||||
if ($mode eq "viewuser")
|
||||
{
|
||||
my $user = LJ::canonical_username($FORM{'user'});
|
||||
my $userid = LJ::get_userid($user);
|
||||
|
||||
$ret .= "<h1><a href='./'><<</a> view user \"$user\"</h1>\n";
|
||||
unless ($userid) {
|
||||
$ret .= "<b>Error:</b> non-existent user\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
$ret .= "<form method='post' action='./'>\n";
|
||||
$ret .= LJ::form_auth();
|
||||
$ret .= "<input type='hidden' name='mode' value='userchange' />\n";
|
||||
$ret .= "<input type='hidden' name='user' value='$user' />\n";
|
||||
$sth = $dbh->prepare("SELECT pm.prmid, pm.prlid, pm.arg FROM priv_map pm, priv_list pl WHERE pm.prlid=pl.prlid AND pm.userid=$userid ORDER BY pl.privcode,pm.arg");
|
||||
$sth->execute;
|
||||
$ret .= "<table cellpadding='5' cellspacing='1' border='1'><tr><td><b>Revoke</b></td><td><b>Privilege</b></td><td><b>Arg</b></td></tr>\n";
|
||||
while (my ($prmid, $prlid, $arg) = $sth->fetchrow_array)
|
||||
{
|
||||
my $prec = $priv{$prlid};
|
||||
my $pcode = $priv{$prlid}->{'privcode'};
|
||||
my $can_grant = remote_can_grant($remote, $pcode, $arg);
|
||||
|
||||
next unless ($prec->{'is_public'} || ($remote && $remote->{'userid'} == $userid) || $can_grant);
|
||||
|
||||
$ret .= "<tr><td align='center'>";
|
||||
if ($can_grant) {
|
||||
$ret .= "<input type='checkbox' name='revoke:$prmid:$userid' />";
|
||||
} else {
|
||||
$ret .= "--";
|
||||
}
|
||||
|
||||
$ret .= "</td><td><a href='./?priv=$pcode'>$pcode</a></td>";
|
||||
if ($arg)
|
||||
{
|
||||
$ret .= "<td><a href='./?priv=$pcode&viewarg=$arg'>$arg</a></td></tr>\n";
|
||||
} else {
|
||||
$ret .= "<td> </td></tr>\n";
|
||||
}
|
||||
}
|
||||
$ret .= "</table>";
|
||||
|
||||
if (LJ::check_priv($remote, 'admin')) {
|
||||
$ret .= "<p>Grant <b>$user</b> privilege:<div style='margin-left: 20px;'>\n";
|
||||
$ret .= "<select name='grantpriv'><option value='' selected='1'></option>";
|
||||
foreach my $priv (@privs) {
|
||||
$ret .= "<option value='$priv->{'prlid'}'>$priv->{'privcode'}</option>";
|
||||
}
|
||||
$ret .= "</select>\n";
|
||||
$ret .= "Arg: <input name='arg' size='10' maxlength='40' /></div>\n";
|
||||
} else {
|
||||
$ret .= "<p><i>(you do not have access to grant any privileges)</i></p>\n";
|
||||
}
|
||||
|
||||
$ret .= "<p>\n";
|
||||
if (LJ::check_priv($remote, 'admin')) {
|
||||
$ret .= "<input type=\"submit\" value=\"Make Changes\" />";
|
||||
}
|
||||
$ret .= " <input type=\"submit\" name=\"submit:refresh\" value=\"Just Refresh\" />";
|
||||
$ret .= "</form>";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
if ($mode eq "viewpriv") {
|
||||
my $priv = $pcode2id{$FORM{'priv'}};
|
||||
my $prec = $priv{$priv};
|
||||
my $pcode = $prec->{'privcode'};
|
||||
my $skip = $FORM{'skip'} + 0;
|
||||
my $limit = 100;
|
||||
|
||||
my $viewarg;
|
||||
if ($FORM{'viewarg'}) {
|
||||
$viewarg = " AND pm.arg=" . $dbh->quote($FORM{'viewarg'});
|
||||
}
|
||||
|
||||
my $privname = join(' ', grep { $_ } $priv{$priv}->{'privcode'}, $FORM{'viewarg'});
|
||||
$ret .= "<h1><a href=\"./\"><<</a> view priv \"$privname\"</h1>\n";
|
||||
$ret .= "<p><b>Privilege Name:</b> $priv{$priv}->{'privname'}";
|
||||
my ($des, $args) = split(/arg=/, $priv{$priv}->{'des'});
|
||||
$ret .= "<br /><b>Description:</b> $des" if $des;
|
||||
$ret .= "<br /><b>Argument:</b> $args" if $args;
|
||||
$ret .= "</p>";
|
||||
|
||||
my ($check_priv, $check_arg) = split("/", $FORM{'viewarg'});
|
||||
unless ($prec->{'is_public'} || remote_can_grant($remote, $check_priv, $check_arg)) {
|
||||
$ret .= "<p><b>ERROR:</b> This privilege's access list is not public.</p>\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
$ret .= "<form style='display: inline;' action='./' method='post'>\n";
|
||||
$ret .= LJ::form_auth();
|
||||
$ret .= "<p><b>View only privs with arg:</b> ";
|
||||
$ret .= "<input name='viewarg' size='10' /> ";
|
||||
$ret .= "<input type='submit' name='submit:load' value='Load' /></p>\n";
|
||||
|
||||
$ret .= "<input type='hidden' name='mode' value='privchange' />\n";
|
||||
$ret .= "<input type='hidden' name='priv' value='$pcode' />";
|
||||
$sth = $dbh->prepare("SELECT pm.prmid, u.user, u.userid, pm.arg ".
|
||||
"FROM priv_map pm, useridmap u WHERE pm.prlid=$priv AND pm.userid=u.userid$viewarg ".
|
||||
"ORDER BY u.user,pm.arg LIMIT $skip,$limit");
|
||||
$sth->execute;
|
||||
$ret .= "<table cellpadding='5' cellspacing='1' border='1'><tr><td><b>Revoke</b></td><td><b>User</b></td><td><b>Arg</b></td></tr>\n";
|
||||
|
||||
my $showgrant = remote_can_grant($remote, $pcode, $FORM{'viewarg'});
|
||||
my $foundcount = 0;
|
||||
|
||||
while ($_ = $sth->fetchrow_hashref)
|
||||
{
|
||||
$foundcount++;
|
||||
$ret .= "<tr><td align='center'>";
|
||||
if (remote_can_grant($remote, $priv{$priv}->{'privcode'}, $_->{'arg'}))
|
||||
{
|
||||
$ret .= "<input type='checkbox' name=\"revoke:$_->{'prmid'}:$_->{'userid'}\" />";
|
||||
} else {
|
||||
$ret .= "--";
|
||||
}
|
||||
$ret .= "</td><td><a href=\"./?user=$_->{'user'}\">$_->{'user'}</a></td>";
|
||||
if ($_->{'arg'} ne "")
|
||||
{
|
||||
$ret .= "<td><a href=\"./?priv=$priv{$priv}->{'privcode'}&viewarg=$_->{'arg'}\">$_->{'arg'}</a></td></tr>\n";
|
||||
} else {
|
||||
$ret .= "<td> </td></tr>\n";
|
||||
}
|
||||
}
|
||||
$ret .= "<tr><td colspan='3'><b>$foundcount users</b></td></tr>\n";
|
||||
$ret .= "</table>";
|
||||
|
||||
if ($foundcount >= $limit) {
|
||||
$ret .= "<a href='" . BML::self_link({'skip'=>($skip +$limit)}) . "'>See more...</a>\n";
|
||||
}
|
||||
|
||||
if ($showgrant) {
|
||||
$ret .= "<p>Grant <b>$privname</b> privilege to:<ul>";
|
||||
$ret .= "User: <input name='grantuser' size='15' maxlength='15' /> ";
|
||||
$ret .= "Arg: <input name='arg' size='10' maxlength='40' value='$FORM{'viewarg'}'/></ul>\n";
|
||||
} else {
|
||||
$ret .= "<p><i>(you don't have access to grant this privilege to other users)</i></p>\n";
|
||||
}
|
||||
|
||||
if ($showgrant) {
|
||||
$ret .= "<input name=\"submit:change\" type='submit' value=\"Make Changes\" />\n";
|
||||
}
|
||||
$ret .= "</form>\n";
|
||||
|
||||
$ret .= "<form style='display: inline;' method='post' action='./'>\n";
|
||||
$ret .= LJ::form_auth();
|
||||
$ret .= LJ::html_hidden('mode', 'privchange',
|
||||
'priv', $pcode,
|
||||
'viewarg', $FORM{'viewarg'}) . "\n";
|
||||
$ret .= "<input type='submit' name=\"submit:refresh\" value=\"Just Refresh\" />\n";
|
||||
$ret .= "</form>\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
return "Unknown mode.";
|
||||
|
||||
_code?>
|
||||
</body>
|
||||
</html>
|
||||
<?_c <LJDEP>
|
||||
lib: cgi-bin/ljlib.pl
|
||||
link: htdocs/admin/priv/index.bml
|
||||
post: htdocs/admin/priv/index.bml
|
||||
</LJDEP _c?>
|
||||
60
livejournal/htdocs/admin/recent_comments.bml
Executable file
60
livejournal/htdocs/admin/recent_comments.bml
Executable file
@@ -0,0 +1,60 @@
|
||||
<html>
|
||||
<head><title>Comment view</title>
|
||||
<body>
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%GET %POST);
|
||||
my $ret;
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
return "<b>Error:</b> You don't have access to viewing recent comments."
|
||||
unless LJ::check_priv($remote, "siteadmin", "commentview");
|
||||
|
||||
my $user = $GET{'user'};
|
||||
my $u;
|
||||
if ($user =~ /^\#(\d+)/) {
|
||||
$u = LJ::load_userid($1);
|
||||
} elsif ($user) {
|
||||
$u = LJ::load_user($user);
|
||||
}
|
||||
unless ($u) {
|
||||
return "<form method='GET'>Username or (#userid) to view comments of: ".
|
||||
"<input name='user' size='15' /><input type='submit' value='Load' /></form>";
|
||||
}
|
||||
$user = $u->{'user'};
|
||||
$ret .= "<a href='recent_comments.bml'><<</a> <b>Recent comments of " . LJ::ljuser($u) . "</b> (\#$u->{userid})<br />\n";
|
||||
|
||||
my $dbcr = LJ::get_cluster_reader($u);
|
||||
return "Error: can't get DB for user" unless $dbcr;
|
||||
|
||||
my $now = time();
|
||||
|
||||
my $sth = $dbcr->prepare("SELECT posttime, journalid, nodetype, nodeid, jtalkid, publicitem ".
|
||||
"FROM talkleft ".
|
||||
"WHERE userid=? ORDER BY posttime DESC LIMIT 250");
|
||||
$sth->execute($u->{'userid'});
|
||||
my %jcount; # jid -> ct
|
||||
while (my $r = $sth->fetchrow_hashref) {
|
||||
$jcount{$r->{'journalid'}}++;
|
||||
next unless $r->{'nodetype'} eq "L"; # log2 comment
|
||||
|
||||
my $ju = LJ::load_userid($r->{'journalid'});
|
||||
my $lrow = LJ::get_log2_row($ju, $r->{'nodeid'});
|
||||
my $hr_ago = sprintf("%.1f", ($now - $r->{'posttime'}) / 3600);
|
||||
|
||||
if ($lrow) {
|
||||
my $talkid = ($r->{'jtalkid'} << 8) + $lrow->{'anum'};
|
||||
my $url = "$LJ::SITEROOT/users/$ju->{user}/$lrow->{ditemid}.html?thread=$talkid\#t$talkid";
|
||||
$ret .= "$hr_ago hr ago in " . LJ::ljuser($ju) . ": <a href='$url'>$url</a><br />\n";
|
||||
} else {
|
||||
$ret .= "$hr_ago hr ago in " . LJ::ljuser($ju) . ": link unavailable<br />";
|
||||
}
|
||||
}
|
||||
|
||||
return $ret;
|
||||
|
||||
}
|
||||
_code?>
|
||||
</body>
|
||||
</html>
|
||||
278
livejournal/htdocs/admin/schema/index.bml
Executable file
278
livejournal/htdocs/admin/schema/index.bml
Executable file
@@ -0,0 +1,278 @@
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
|
||||
$title = "Schema Browser";
|
||||
$body = "";
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
my $sth;
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
my $can_doc = 0;
|
||||
if (LJ::remote_has_priv($remote, "schemadoc")) { $can_doc = 1; }
|
||||
unless ($can_doc) {
|
||||
my $url = "/doc/server/ljp.dbschema.ref.html";
|
||||
$body = "This page is for editing <a href=\"$url\">schema documentation</a>, ";
|
||||
$body .= "but you don't have the 'schemadoc' priv.";
|
||||
return;
|
||||
}
|
||||
|
||||
sub magic_links
|
||||
{
|
||||
my $des = shift;
|
||||
$$des =~ s!\[dbtable\[(\w+?)\]\]!<a href="./?mode=viewtable&table=$1">$1</a>!g;
|
||||
}
|
||||
|
||||
if ($FORM{'mode'} eq "")
|
||||
{
|
||||
my %table;
|
||||
$sth = $dbh->prepare("SELECT tablename, public_browsable, des FROM schematables");
|
||||
$sth->execute;
|
||||
while (my ($name, $public, $des) = $sth->fetchrow_array) {
|
||||
$table{$name} = { 'public' => $public, 'des' => $des };
|
||||
}
|
||||
|
||||
$body .= "<?h1 Tables h1?><?p Click a table for more information. p?><p><table cellpadding=4><tr bgcolor=<?emcolor?>><td><b>Table</b></td><td><b>Description</b></td></tr>\n";
|
||||
$sth = $dbh->prepare("SHOW TABLES");
|
||||
$sth->execute;
|
||||
while (my ($table) = $sth->fetchrow_array) {
|
||||
my $des = $table{$table}->{'des'} || "<i>no description, yet</i>";
|
||||
magic_links(\$des);
|
||||
$body .= "<tr valign=top><td nowrap><b><a href=\"./?mode=viewtable&table=$table\">$table</a></b>";
|
||||
if ($table{$table}->{'public'}) {
|
||||
$body .= " (<a href=\"./?mode=viewdata&table=$table\">data</a>)";
|
||||
}
|
||||
$body .= "</td><td>$des</td></tr>\n";
|
||||
}
|
||||
$body .= "</table>\n";
|
||||
return;
|
||||
}
|
||||
|
||||
if ($FORM{'mode'} eq "viewtable")
|
||||
{
|
||||
my $table = $FORM{'table'};
|
||||
if ($table !~ /^\w+$/) { $body = "Invalid table name!\n"; return; }
|
||||
my $qtable = $dbh->quote($table);
|
||||
|
||||
$sth = $dbh->prepare("SELECT des, public_browsable FROM schematables WHERE tablename=$qtable");
|
||||
$sth->execute;
|
||||
my ($tabledes, $browsable) = $sth->fetchrow_array;
|
||||
|
||||
$body .= "<a href=\"./\"><< Tables</a>";
|
||||
if ($browsable) {
|
||||
$body .= " | <a href=\"./?mode=viewdata&table=$table\">View Data</a>";
|
||||
}
|
||||
if ($can_doc) {
|
||||
$body .= " | <a href=\"./?mode=doc&table=$table\">Edit Documentation</a>";
|
||||
}
|
||||
$body .= "<?h1 Table: $table h1?><?p ";
|
||||
|
||||
|
||||
if ($tabledes) {
|
||||
&magic_links(\$tabledes);
|
||||
$body .= $tabledes;
|
||||
} else {
|
||||
$body .= "Below are the columns and descriptions for the <b>$table</b> table.";
|
||||
}
|
||||
$body .= " p?><p>\n";
|
||||
|
||||
my %coldes;
|
||||
$sth = $dbh->prepare("SELECT colname, des FROM schemacols WHERE tablename=$qtable");
|
||||
$sth->execute;
|
||||
while (my ($col, $des) = $sth->fetchrow_array) { $coldes{$col} = $des; }
|
||||
|
||||
$sth = $dbh->prepare("DESCRIBE $table");
|
||||
$sth->execute;
|
||||
$body .= "<table cellpadding=3><tr bgcolor=<?emcolor?>>";
|
||||
$body .= "<td><b>Key?</b></td>";
|
||||
$body .= "<td><b>Column</b></td>";
|
||||
$body .= "<td><b>Type</b></td>";
|
||||
$body .= "<td><b>Null</b></td>";
|
||||
$body .= "<td><b>Default</b></td>";
|
||||
$body .= "<td><b>Description</b></td>";
|
||||
$body .= "</tr>\n";
|
||||
while (my $row = $sth->fetchrow_hashref)
|
||||
{
|
||||
my $name = $row->{'Field'};
|
||||
my $type = $row->{'Type'};
|
||||
my $key = $row->{'Key'};
|
||||
my $null = $row->{'Null'};
|
||||
my $def = $row->{'Default'};
|
||||
my $des = BML::eall($coldes{$name});
|
||||
|
||||
magic_links(\$des);
|
||||
|
||||
$type =~ s/int\(\d+\)/int/g;
|
||||
|
||||
$body .= "<tr valign=top>";
|
||||
$body .= "<td align=center>$key</td>";
|
||||
$body .= "<td><b>$name</b></td>";
|
||||
$body .= "<td>$type</td>";
|
||||
$body .= "<td align=center>$null</td>";
|
||||
$body .= "<td align=center>$def</td>";
|
||||
$body .= "<td>$des</td>";
|
||||
$body .= "</tr>\n";
|
||||
}
|
||||
$body .= "</table>\n";
|
||||
return;
|
||||
}
|
||||
|
||||
if ($FORM{'mode'} eq "viewdata") {
|
||||
my $table = $FORM{'table'};
|
||||
if ($table !~ /^\w+$/) { $body = "Invalid table name!\n"; return; }
|
||||
|
||||
my $MAX_ROWS = 100;
|
||||
|
||||
$body .= "<a href=\"./\"><< Tables</a><br><a href=\"./?mode=viewtable&table=$table\"><< Table: $table</a><?h1 Data: $table h1?><?p Below are the rows in the <b>$table</b> table. If the table has more than $MAX_ROWS records, only the top $MAX_ROWS are shown. p?><p>\n";
|
||||
|
||||
$sth = $dbh->prepare("SELECT tablename, public_browsable, des FROM schematables WHERE tablename='$table'");
|
||||
$sth->execute;
|
||||
my ($tablename, $public, $des) = $sth->fetchrow_array;
|
||||
unless ($public) { $body .= "This table's data is not public.\n"; return; }
|
||||
|
||||
$sth = $dbh->prepare("SELECT * FROM $table LIMIT $MAX_ROWS");
|
||||
$sth->execute;
|
||||
$body .= "<table cellpadding=3><tr bgcolor=<?emcolor?>>";
|
||||
foreach my $col (@{$sth->{'NAME'}}) {
|
||||
$body .= "<td><b>$col</b></td>\n";
|
||||
}
|
||||
$body .= "</tr>\n";
|
||||
|
||||
while (my $row = $sth->fetchrow_arrayref) {
|
||||
$body .= "<tr valign=top>\n";
|
||||
foreach my $val (@$row) {
|
||||
$body .= "<td>$val</td>\n";
|
||||
}
|
||||
$body .= "</tr>\n";
|
||||
}
|
||||
$body .= "</table>\n";
|
||||
return;
|
||||
}
|
||||
|
||||
# show form to enter documentation
|
||||
if ($FORM{'mode'} eq "doc")
|
||||
{
|
||||
unless ($can_doc) { $body .= "You don't have permissions to document the schema."; return; }
|
||||
my $table = $FORM{'table'};
|
||||
if ($table !~ /^\w+$/) { $body = "Invalid table name!\n"; return; }
|
||||
|
||||
$body .= "<a href=\"./\"><< Tables</a><?h1 Document Table: $table h1?>";
|
||||
|
||||
my $qtable = $dbh->quote($table);
|
||||
my $sth;
|
||||
|
||||
$sth = $dbh->prepare("SELECT des FROM schematables WHERE tablename=$qtable");
|
||||
$sth->execute;
|
||||
my ($tabledes) = $sth->fetchrow_array;
|
||||
|
||||
my %coldes;
|
||||
$sth = $dbh->prepare("SELECT colname, des FROM schemacols WHERE tablename=$qtable");
|
||||
$sth->execute;
|
||||
while (my ($col, $des) = $sth->fetchrow_array) { $coldes{$col} = $des; }
|
||||
|
||||
$body .= "<form method=post action=\"./\">\n";
|
||||
$body .= "<input type=hidden name=table value=\"$table\">\n";
|
||||
$body .= "<input type=hidden name=mode value=\"docsave\">\n";
|
||||
$body .= "<p><b>Description:</b><br><textarea name=\"table-des\" rows=10 cols=40 wrap=soft>";
|
||||
$body .= BML::eall($tabledes) . "</textarea>";
|
||||
|
||||
$sth = $dbh->prepare("DESCRIBE $table");
|
||||
$sth->execute;
|
||||
$body .= "<p><table cellpadding=3><tr bgcolor=<?emcolor?>>";
|
||||
$body .= "<td><b>Column</b></td>";
|
||||
$body .= "<td><b>Type</b></td>";
|
||||
$body .= "<td><b>Description</b></td>";
|
||||
$body .= "</tr>\n";
|
||||
while (my $row = $sth->fetchrow_hashref)
|
||||
{
|
||||
my $name = $row->{'Field'};
|
||||
my $type = $row->{'Type'};
|
||||
$type =~ s/int\(\d+\)/int/g;
|
||||
|
||||
$body .= "<tr valign=top>";
|
||||
$body .= "<td><b>$name</b></td>";
|
||||
$body .= "<td>$type</td>";
|
||||
$body .= "<td><input name=\"col-$name\" size=60 maxlength=255 value=\"" . BML::eall($coldes{$name}) . "\"></td>";
|
||||
$body .= "</tr>\n";
|
||||
}
|
||||
$body .= "</table>\n";
|
||||
$body .= "<p><input type=submit value=\"Save Changes\"></form>";
|
||||
return;
|
||||
}
|
||||
|
||||
# save documentation
|
||||
if ($FORM{'mode'} eq "docsave")
|
||||
{
|
||||
unless ($can_doc) { $body .= "You don't have permissions to document the schema."; return; }
|
||||
my $table = $FORM{'table'};
|
||||
if ($table !~ /^\w+$/) { $body = "Invalid table name!\n"; return; }
|
||||
|
||||
$body .= "<a href=\"./\"><< Tables</a><?h1 Document Table: $table h1?>";
|
||||
|
||||
my $qtable = $dbh->quote($table);
|
||||
my $sth;
|
||||
|
||||
$sth = $dbh->prepare("SELECT tablename, des FROM schematables WHERE tablename=$qtable");
|
||||
$sth->execute;
|
||||
my ($tablename, $tabledes) = $sth->fetchrow_array;
|
||||
$FORM{'table-des'} =~ s/\r//;
|
||||
my $qdes = $dbh->quote($FORM{'table-des'});
|
||||
if ($tablename) {
|
||||
# row exists, update.
|
||||
$dbh->do("UPDATE schematables SET des=$qdes WHERE tablename=$qtable");
|
||||
} else {
|
||||
# no row exists, so insert
|
||||
$dbh->do("INSERT INTO schematables (tablename, public_browsable, des) VALUES ($qtable, '0', $qdes)");
|
||||
}
|
||||
if ($dbh->err) { $body .= $dbh->errstr; return; }
|
||||
|
||||
my %olddes;
|
||||
my %newdes;
|
||||
|
||||
### load old descriptions
|
||||
$sth = $dbh->prepare("SELECT colname, des FROM schemacols WHERE tablename=$qtable");
|
||||
$sth->execute;
|
||||
while (my ($col, $des) = $sth->fetchrow_array) { $olddes{$col} = $des; }
|
||||
|
||||
### check new descriptions (only for valid columns)
|
||||
$sth = $dbh->prepare("DESCRIBE $table");
|
||||
$sth->execute;
|
||||
if ($dbh->err) { $body .= $dbh->errstr; return; }
|
||||
while (my $row = $sth->fetchrow_hashref)
|
||||
{
|
||||
my $name = $row->{'Field'};
|
||||
my $type = $row->{'Type'};
|
||||
|
||||
$FORM{"col-$name"} =~ s/\r//;
|
||||
if ($FORM{"col-$name"} ne $olddes{$name}) {
|
||||
$newdes{$name} = $FORM{"col-$name"};
|
||||
}
|
||||
}
|
||||
if (%newdes) {
|
||||
my $sql = "REPLACE INTO schemacols (tablename, colname, des) VALUES ";
|
||||
foreach my $col (keys %newdes) {
|
||||
my $qcol = $dbh->quote($col);
|
||||
my $qdes = $dbh->quote($newdes{$col});
|
||||
$sql .= "($qtable, $qcol, $qdes),";
|
||||
}
|
||||
chop $sql;
|
||||
$dbh->do($sql);
|
||||
if ($dbh->err) { $body .= "[3] ($sql)<p>" . $dbh->errstr; return; }
|
||||
}
|
||||
|
||||
$body .= "<?h1 Success h1?><?p Documentation saved. <a href=\"./?mode=viewtable&table=$table\">View</a>. p?>";
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
return;
|
||||
|
||||
_code?><?page
|
||||
title=><?_code return $title; _code?>
|
||||
body=><?_code return $body; _code?>
|
||||
page?><?_c <LJDEP>
|
||||
link: htdocs/admin/scheme/index.bml
|
||||
</LJDEP> _c?>
|
||||
276
livejournal/htdocs/admin/spamreports.bml
Executable file
276
livejournal/htdocs/admin/spamreports.bml
Executable file
@@ -0,0 +1,276 @@
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw($title $body %GET %POST);
|
||||
|
||||
$title = "Spam Reports";
|
||||
$body = "";
|
||||
|
||||
my $error = sub {
|
||||
$title = "Error";
|
||||
$body = join '', @_;
|
||||
return undef;
|
||||
};
|
||||
my $makelink = sub {
|
||||
my ($by, $what, $state, $reporttime, $etext) = @_;
|
||||
$by = LJ::eurl($by);
|
||||
$what = LJ::eurl($what);
|
||||
$state = LJ::eurl($state);
|
||||
$reporttime = LJ::mysql_time($reporttime);
|
||||
$reporttime = $etext if $etext;
|
||||
return "<a href=\"spamreports.bml?mode=view&by=$by&what=$what&state=$state\">$reporttime</a>";
|
||||
};
|
||||
my $dellink = sub {
|
||||
my ($by, $what, $text) = @_;
|
||||
return "<form method=\"post\" action=\"spamreports.bml\">" .
|
||||
LJ::html_hidden('mode', $by) .
|
||||
LJ::html_hidden('what', $what) .
|
||||
LJ::html_hidden('ret', "spamreports.bml?" . join('&', map { "$_=" . LJ::eurl($GET{$_}) } keys %GET)) .
|
||||
LJ::html_submit('submit', $text) .
|
||||
"</form>";
|
||||
};
|
||||
|
||||
# login check
|
||||
my $remote = LJ::get_remote();
|
||||
return $error->("You must be logged in to be here.")
|
||||
unless $remote;
|
||||
|
||||
# priv check
|
||||
return $error->("You do not have the necessary privilege to be here.")
|
||||
unless LJ::check_priv($remote, 'siteadmin', 'spamreports');
|
||||
|
||||
# show the top 10 spam reports by IP
|
||||
my $mode = lc($GET{mode} || $POST{mode});
|
||||
$mode = '' if $mode =~ /^del/ && !LJ::did_post() && !LJ::check_referer('/admin/spamreports.bml');
|
||||
|
||||
# combined/user/anon viewing?
|
||||
my $view = $mode =~ /_([cua])$/ ? $1 : 'c';
|
||||
my ($extrawhere, $extratitle);
|
||||
if ($view eq 'c') { $extrawhere = '1'; }
|
||||
elsif ($view eq 'u') { $extrawhere = 'posterid > 0'; $extratitle = " - Users Only"; }
|
||||
elsif ($view eq 'a') { $extrawhere = 'posterid = 0'; $extratitle = " - Anonymous Only"; }
|
||||
$mode =~ s/_[cua]$//; # strip out viewing option
|
||||
|
||||
my $dbr = LJ::get_db_reader();
|
||||
return $error->("Unable to get database reader handle.") unless $dbr;
|
||||
my @rows;
|
||||
my @headers;
|
||||
if ($mode eq 'top10ip') {
|
||||
# top 10 by ip
|
||||
$title = "Spam Reports - Top 10 by IP Address";
|
||||
@headers = ('Number of Reports', 'IP Address', 'Most Recent Report');
|
||||
my $res = $dbr->selectall_arrayref('SELECT COUNT(ip) AS num, ip, MAX(reporttime) FROM spamreports ' .
|
||||
"WHERE state = 'open' AND ip IS NOT NULL " .
|
||||
'GROUP BY ip ORDER BY num DESC LIMIT 10');
|
||||
foreach (@$res) {
|
||||
push @rows, [ $_->[0], $_->[1], $makelink->('ip', $_->[1], 'open', $_->[2]) ];
|
||||
}
|
||||
|
||||
} elsif ($mode eq 'top10user') {
|
||||
# top 10 by user
|
||||
$title = "Spam Reports - Top 10 by User";
|
||||
@headers = ('Number of Reports', 'Posted By User', 'Most Recent Report');
|
||||
my $res = $dbr->selectall_arrayref('SELECT COUNT(posterid) AS num, posterid, MAX(reporttime) FROM spamreports ' .
|
||||
"WHERE state = 'open' AND posterid > 0 " .
|
||||
'GROUP BY posterid ORDER BY num DESC LIMIT 10');
|
||||
foreach (@$res) {
|
||||
my $u = LJ::load_userid($_->[1]);
|
||||
push @rows, [ $_->[0], LJ::ljuser($u), $makelink->('posterid', $_->[1], 'open', $_->[2]) ];
|
||||
}
|
||||
|
||||
} elsif ($mode eq 'tlast10') {
|
||||
# most recent 10 reports
|
||||
$title = "Spam Reports - Last 10$extratitle";
|
||||
@headers = ('Posted By', 'Posted In', 'Report Time');
|
||||
my $res = $dbr->selectall_arrayref('SELECT posterid, ip, journalid, reporttime FROM spamreports ' .
|
||||
"WHERE state = 'open' AND $extrawhere ORDER BY reporttime DESC LIMIT 10");
|
||||
foreach (@$res) {
|
||||
my $u2 = LJ::load_userid($_->[2]);
|
||||
if ($_->[0] > 0) {
|
||||
my $u = LJ::load_userid($_->[0]);
|
||||
push @rows, [ LJ::ljuser($u), LJ::ljuser($u2), $makelink->('posterid', $_->[0], 'open', $_->[3]) ];
|
||||
} else {
|
||||
push @rows, [ "$_->[1]", LJ::ljuser($u2), $makelink->('ip', $_->[1], 'open', $_->[3]) ];
|
||||
}
|
||||
}
|
||||
|
||||
} elsif ($mode =~ /^last(\d+)hr$/) {
|
||||
# reports in last X hours
|
||||
my $hours = $1+0;
|
||||
my $secs = $hours * 3600; # seconds in an hour
|
||||
$title = "Spam Reports - Last $hours Hour" . ($hours == 1 ? '' : 's') . $extratitle;
|
||||
@headers = ('Number of Reports', 'Posted By', 'Report Time');
|
||||
my $res = $dbr->selectall_arrayref('SELECT journalid, ip, posterid, reporttime FROM spamreports ' .
|
||||
"WHERE $extrawhere AND reporttime > (UNIX_TIMESTAMP() - $secs) LIMIT 1000");
|
||||
|
||||
# count up items and their most recent report
|
||||
my %hits;
|
||||
my %times;
|
||||
foreach (@$res) {
|
||||
my $key;
|
||||
if ($_->[2] > 0) {
|
||||
my $u = LJ::load_userid($_->[2]);
|
||||
next unless $u;
|
||||
$key = $u->{userid};
|
||||
} else {
|
||||
next unless $_->[1];
|
||||
$key = $_->[1];
|
||||
}
|
||||
$hits{$key}++;
|
||||
$times{$key} = $_->[3] unless $times{$key} gt $_->[3];
|
||||
}
|
||||
|
||||
# now reverse to number => item list
|
||||
my %revhits;
|
||||
foreach (keys %hits) {
|
||||
if ($revhits{$hits{$_}}) {
|
||||
push @{$revhits{$hits{$_}}}, $_;
|
||||
} else {
|
||||
$revhits{$hits{$_}} = [ $_ ];
|
||||
}
|
||||
}
|
||||
|
||||
# now push them onto @rows
|
||||
foreach (sort { $b <=> $a } keys %revhits) {
|
||||
my $r = $revhits{$_};
|
||||
foreach (@$r) {
|
||||
my $isip = $_ =~ /\./ ? 1 : 0;
|
||||
push @rows, [ $hits{$_}, $isip ? $_ : LJ::ljuser(LJ::load_userid($_)),
|
||||
$makelink->($isip ? 'ip' : 'posterid', $_, 'open', $times{$_}) ];
|
||||
}
|
||||
}
|
||||
|
||||
} elsif ($mode eq 'view') {
|
||||
# view a particular report
|
||||
my ($by, $what, $state) = (lc($GET{by}), $GET{what}, lc($GET{state}));
|
||||
$by = '' unless $by =~ /^(?:ip|poster(?:id)?)$/;
|
||||
$state = 'open' unless $state =~ /^(?:open|closed)$/;
|
||||
$body .= "<?p [ <a href=\"spamreports.bml\"><< Front Page</a> ] ";
|
||||
|
||||
# open/closed links
|
||||
my $eargs = LJ::eurl("?by=$by&what=$what&state");
|
||||
if ($state eq 'open') {
|
||||
$body .= " [ " . $makelink->($by, $what, 'closed', undef, "View Closed Reports") . " ]";
|
||||
} else {
|
||||
$body .= " [ " . $makelink->($by, $what, 'open', undef, "View Open Reports") . " ]";
|
||||
}
|
||||
$body .= " p?>\n";
|
||||
|
||||
# setup title and verify that the data is right
|
||||
if ($by eq 'posterid') {
|
||||
$what += 0;
|
||||
my $u = LJ::load_userid($what);
|
||||
return $error->('No such posterid.') unless $u;
|
||||
$title = "Spam Reports - By $u->{user} ($state)";
|
||||
} elsif ($by eq 'poster') {
|
||||
my $u = LJ::load_user($what);
|
||||
return $error->('No such user.') unless $u;
|
||||
$title = "Spam Reports - Comments By $u->{user}";
|
||||
|
||||
# Now just pretend that user used 'posterid'
|
||||
$by = 'posterid';
|
||||
$what = $u->{userid};
|
||||
} elsif ($by eq 'ip') {
|
||||
# check for right format x.x.x.x, not necessarily a valid IP
|
||||
return $error->('No such IP.') if $what !~ /^\d+\.\d+\.\d+\.\d+$/ or length $what > 15;
|
||||
$title = "Spam Reports - By IP $what ($state)";
|
||||
}
|
||||
|
||||
# see if we should call a hook for extra actions?
|
||||
$body .= LJ::run_hook('spamreport_notification', $remote, { $by => $what })
|
||||
if $state eq 'open' && $by eq 'posterid';
|
||||
|
||||
# now the general info gathering
|
||||
my $res = $dbr->selectall_arrayref('SELECT reporttime, journalid, subject, body, ip, posttime, report_type ' .
|
||||
"FROM spamreports WHERE state=? AND $by=? ORDER BY reporttime DESC LIMIT 1000",
|
||||
undef, $state, $what);
|
||||
unless ($res && @$res) {
|
||||
$body .= "No reports found.";
|
||||
return undef;
|
||||
}
|
||||
$body .= '<table>';
|
||||
foreach (@$res) {
|
||||
my $u2 = LJ::load_userid($_->[1]);
|
||||
my $x = $by eq 'ip' ? 4 : 1;
|
||||
my $comment_body = $_->[3];
|
||||
LJ::text_uncompress(\$comment_body);
|
||||
my $spamlocation = ($_->[6] eq 'entry') ? 'Entry' : 'Comment';
|
||||
$body .= '<tr><td>' . ($state eq 'open' ? $dellink->("del$by", "$_->[0]:$_->[$x]", 'Close') : '') . '</td><td>' .
|
||||
"<strong>$spamlocation in:</strong> " . LJ::ljuser($u2) . '<br />' .
|
||||
'<strong>Report Time:</strong> ' . LJ::mysql_time($_->[0]) . '<br />' .
|
||||
"<strong>$spamlocation Time:</strong> " . ($_->[5] ? LJ::mysql_time($_->[5]) : 'not recorded') . '<br />' .
|
||||
'<strong>Subject:</strong> ' . LJ::ehtml($_->[2] || 'no subject') . '<br />' .
|
||||
'<strong>Body:</strong> ' . LJ::ehtml($comment_body || 'no body') . '<br />' .
|
||||
'</td></tr><tr><td> </td></tr>';
|
||||
}
|
||||
$body .= "</table><br />" . ($state eq 'open' ? $dellink->("delby$by", $what, 'Close All') : '');
|
||||
|
||||
} elsif ($mode =~ /^del/) {
|
||||
# figure out our combination
|
||||
my $dbh = LJ::get_db_writer();
|
||||
return $error->("Unable to get database writer handle.") unless $dbh;
|
||||
my ($sql, $count, $backlink);
|
||||
if ($mode =~ /^delby/) {
|
||||
# enmasse deletion
|
||||
my $where = $mode =~ /ip$/ ? 'ip' : 'posterid';
|
||||
$sql = "UPDATE spamreports SET state='closed' WHERE $where=?";
|
||||
$count = $dbh->do($sql, undef, $POST{what});
|
||||
return $error->($dbh->errstr) if $dbh->err;
|
||||
} else {
|
||||
# single item deletion
|
||||
my $where = $mode =~ /ip$/ ? 'ip' : 'journalid';
|
||||
my ($time, $data) = ($1, $2)
|
||||
if $POST{what} =~ /^(\d+):(.+)$/;
|
||||
$data ||= $POST{what};
|
||||
$count = $dbh->do("UPDATE spamreports SET state='closed' WHERE reporttime=? AND $where=? AND state='open'", undef, $time, $data);
|
||||
return $error->($dbh->errstr) if $dbh->err;
|
||||
$backlink = "[ <a href='$POST{ret}'><< Go Back</a> ]";
|
||||
}
|
||||
$title = "Close Reports";
|
||||
$body .= "<?p [ <a href=\"spamreports.bml\"><< Front Page</a> ] $backlink p?>\n";
|
||||
my $s = $count == 1 ? '' : 's';
|
||||
$body .= "Closed $count report$s.\n";
|
||||
|
||||
} else {
|
||||
# standard
|
||||
my %modes = (top10user => 'Top 10 by User', top10ip => 'Top 10 by IP Address', tlast10 => 'Last 10 Reports',
|
||||
last01hr => 'Last 1 Hour', last06hr => 'Last 6 Hours', last24hr => 'Last 24 Hours');
|
||||
$body .= "<?p Available reports: p?>\n<ul>";
|
||||
foreach (sort keys %modes) {
|
||||
$body .= "<li><a href=\"spamreports.bml?mode=$_\">$modes{$_}</a>";
|
||||
if ($_ =~ /last/) {
|
||||
# this is a last view, so we have other options
|
||||
$body .= " [<a href=\"spamreports.bml?mode=${_}_u\">users</a>, ";
|
||||
$body .= "<a href=\"spamreports.bml?mode=${_}_a\">anonymous</a>]";
|
||||
}
|
||||
$body .= "</li>";
|
||||
}
|
||||
$body .= qq{<li><form method="GET" action="spamreports.bml" style="display: inline; margin: 0;">
|
||||
<label for="repu">Reports for user:
|
||||
<input type="text" name="what" size="15" maxlength="15" id="repu" />
|
||||
<input type="hidden" name="by" value="poster" />
|
||||
<input type="hidden" name="mode" value="view" />
|
||||
</label></form></li>
|
||||
};
|
||||
$body .= "</ul>\n<?p Please select one of the above reports to view. Actions can be taken when viewing a report. p?>";
|
||||
}
|
||||
|
||||
# now spit out the requested table
|
||||
return unless @headers;
|
||||
$body .= "<?p [ <a href=\"spamreports.bml\"><< Front Page</a> ] p?>";
|
||||
$body .= "<table width=\"50%\">\n<tr>";
|
||||
$body .= "<th align=\"center\">$_</th>" foreach @headers;
|
||||
$body .= "</tr>\n";
|
||||
foreach (@rows) {
|
||||
$body .= "<tr>";
|
||||
$body .= "<td align=\"center\">$_</td>" foreach @$_;
|
||||
$body .= "</tr>\n";
|
||||
}
|
||||
$body .= "</table>\n";
|
||||
|
||||
return;
|
||||
}
|
||||
_code?><?page
|
||||
title=><?_code return $title; _code?>
|
||||
body=><?_code return $body; _code?>
|
||||
page?>
|
||||
122
livejournal/htdocs/admin/statushistory.bml
Executable file
122
livejournal/htdocs/admin/statushistory.bml
Executable file
@@ -0,0 +1,122 @@
|
||||
<html>
|
||||
<head><title>Status History</title></head>
|
||||
<body>
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%FORM);
|
||||
|
||||
my $dbr = LJ::get_db_reader();
|
||||
|
||||
# check privs
|
||||
my $remote = LJ::get_remote();
|
||||
unless (LJ::check_priv($remote, "historyview")) {
|
||||
return "Sorry, you don't have access to view this page.";
|
||||
}
|
||||
|
||||
my $ret;
|
||||
|
||||
$ret .= "Fill in at least one field below:";
|
||||
$ret .= "<form method='post' action='statushistory.bml'>\n";
|
||||
$ret .= LJ::html_hidden('orderby', $FORM{'orderby'}, 'flow', $FORM{'flow'}) . "\n";
|
||||
$ret .= "User: " . LJ::html_text({ 'name' => 'user', 'size' => '15', 'maxlength' => '15' }) . "\n";
|
||||
$ret .= "Admin: " . LJ::html_text({ 'name' => 'admin', 'size' => '15', 'maxlength' => '15' }) . "\n";
|
||||
$ret .= "Type: " . LJ::html_text({ 'name' => 'type', 'size' => '20', 'maxlength' => '20' }) . "\n";
|
||||
$ret .= LJ::html_submit('query_submit', 'Search');
|
||||
$ret .= "</form>\n\n";
|
||||
|
||||
return $ret unless ($FORM{'user'} || $FORM{'admin'} || $FORM{'type'});
|
||||
|
||||
$ret .= "<hr size='1'>\n\n";
|
||||
|
||||
# build query
|
||||
my @where;
|
||||
if ($FORM{'user'} ne "") {
|
||||
my $userid = LJ::get_userid($FORM{'user'});
|
||||
unless ($userid) { return "unknown user"; }
|
||||
push @where, "s.userid=$userid";
|
||||
}
|
||||
|
||||
if ($FORM{'admin'} ne "") {
|
||||
my $userid = LJ::get_userid($FORM{'admin'});
|
||||
unless ($userid) { return "unknown admin"; }
|
||||
push @where, "s.adminid=$userid";
|
||||
}
|
||||
|
||||
if ($FORM{'type'} ne "") {
|
||||
my $qt = $dbr->quote($FORM{'type'});
|
||||
push @where, "s.shtype=$qt";
|
||||
}
|
||||
|
||||
my $where = "WHERE " . join(" AND ", @where) . " " if @where;
|
||||
|
||||
my $orderby = 'shdate';
|
||||
foreach (qw(user admin shdate shtype notes)) {
|
||||
$orderby = "u.$_", next if $FORM{'orderby'} eq $_ && $_ eq 'user';
|
||||
$orderby = "ua.$_", next if $FORM{'orderby'} eq $_ && $_ eq 'admin';
|
||||
$orderby = "s.$_" if $FORM{'orderby'} eq $_;
|
||||
}
|
||||
my $flow = $FORM{'flow'} eq 'asc' ? 'ASC' : 'DESC';
|
||||
|
||||
my $sth = $dbr->prepare("SELECT u.user, ua.user AS admin, s.shtype, s.shdate, s.notes " .
|
||||
"FROM statushistory s " .
|
||||
"LEFT JOIN useridmap ua ON s.adminid=ua.userid " .
|
||||
"LEFT JOIN useridmap u ON s.userid=u.userid " .
|
||||
$where .
|
||||
"ORDER BY $orderby $flow LIMIT 1000");
|
||||
$sth->execute;
|
||||
return $dbr->errstr if $dbr->err;
|
||||
|
||||
# column headings w/ sort links
|
||||
$ret .= "<p><b>Query:";
|
||||
foreach (qw(user admin type)) {
|
||||
$ret .= " $_=" . LJ::eall($FORM{$_}) if $FORM{$_}
|
||||
}
|
||||
$ret .= "</b></p>\n";
|
||||
$ret .= "<table border='1' cellpadding='5' width='100%'>\n<tr>";
|
||||
foreach (qw(user admin shtype shdate notes)) {
|
||||
my $link = "statushistory.bml?user=$FORM{'user'}&admin=$FORM{'admin'}&type=$FORM{'type'}&orderby=$_";
|
||||
$link .= $FORM{'orderby'} eq $_ && $FORM{'flow'} eq 'asc' ? "&flow=desc" : "&flow=asc";
|
||||
$ret .= "<td><b><a href='$link'>$_</a></b></td>";
|
||||
}
|
||||
$ret .= "</tr>\n";
|
||||
|
||||
# query built above
|
||||
my $ct = 0;
|
||||
while (my $hist = $sth->fetchrow_hashref) {
|
||||
# see if they can see this item: either they have unarged historyview or
|
||||
# they have historyview:shtype
|
||||
next unless LJ::check_priv($remote, 'historyview', '') ||
|
||||
LJ::check_priv($remote, 'historyview', $hist->{shtype});
|
||||
|
||||
$ret .= "<tr>";
|
||||
foreach (qw(user admin shtype shdate notes)) {
|
||||
|
||||
$ret .= "<td>";
|
||||
if ($hist->{$_} && ($_ eq 'user' || $_ eq 'admin')) {
|
||||
$ret .= LJ::ljuser($hist->{$_});
|
||||
} elsif ($_ eq 'notes') {
|
||||
# notes need to be ehtml'd, but afterwards, we can convert \n to <br />
|
||||
my $enotes = LJ::ehtml($hist->{$_});
|
||||
$enotes =~ s!\n!<br />\n!g;
|
||||
$ret .= $enotes;
|
||||
} else {
|
||||
$ret .= LJ::ehtml($hist->{$_});
|
||||
}
|
||||
$ret .= "</td>";
|
||||
}
|
||||
$ret .= "</tr>\n";
|
||||
$ct++;
|
||||
}
|
||||
|
||||
$ret .= "<tr><td colspan='5'><b>$ct rows in set";
|
||||
$ret .= "[truncated]" if $ct >= 1000;
|
||||
$ret .= "</b></td></tr>\n";
|
||||
$ret .= "</table>\n\n";
|
||||
|
||||
return $ret;
|
||||
}
|
||||
_code?>
|
||||
</body>
|
||||
</html>
|
||||
|
||||
1
livejournal/htdocs/admin/topics/blank.bml
Executable file
1
livejournal/htdocs/admin/topics/blank.bml
Executable file
@@ -0,0 +1 @@
|
||||
|
||||
34
livejournal/htdocs/admin/topics/index.bml
Executable file
34
livejournal/htdocs/admin/topics/index.bml
Executable file
@@ -0,0 +1,34 @@
|
||||
<?page
|
||||
title=>Topic Directory Administration
|
||||
body<=
|
||||
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
|
||||
my $ret;
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
if (LJ::remote_has_priv($remote, "topicaddtopic")) {
|
||||
$ret .= "<P><A HREF=\"screentop.bml\"><B>Screen Topic Submissions</B></A> that are awaiting approval into a category.";
|
||||
}
|
||||
|
||||
if (LJ::remote_has_priv($remote, "topicscreencat")) {
|
||||
$ret .= "<P><A HREF=\"screen.html\"><B>Screen Entry Submissions</B></A> that are awaiting approval into a topic.";
|
||||
}
|
||||
|
||||
unless ($ret) {
|
||||
$ret .= "You have no administrative priviledges in this area, or you are not logged in.";
|
||||
}
|
||||
|
||||
return $ret;
|
||||
|
||||
_code?>
|
||||
|
||||
|
||||
<=body
|
||||
page?><?_c <LJDEP>
|
||||
link: htdocs/admin/topics/screentop.bml, htdocs/admin/topics/screen.html
|
||||
</LJDEP> _c?>
|
||||
|
||||
30
livejournal/htdocs/admin/topics/links.bml
Executable file
30
livejournal/htdocs/admin/topics/links.bml
Executable file
@@ -0,0 +1,30 @@
|
||||
<?_code
|
||||
|
||||
return "This page is old and uses a horrendous database query. It won't likely return.";
|
||||
|
||||
my $user = $FORM{'user'};
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
my $sth = $dbh->prepare("SELECT styleid, user, styledes, type, is_embedded, is_colorfree FROM style WHERE is_public='Y' ORDER BY user");
|
||||
$sth->execute;
|
||||
|
||||
my $ret = "";
|
||||
my $last = "";
|
||||
while ($sty = $sth->fetchrow_hashref) {
|
||||
if ($last ne $sty->{'user'}) {
|
||||
$last = $sty->{'user'};
|
||||
$ret .= "<B>$last</B><BR>\n";
|
||||
}
|
||||
if ($user) {
|
||||
$ret .= " - <A TARGET=\"main\" HREF=\"/customview.cgi?styleid=$sty->{'styleid'}&user=$user\">$sty->{'styledes'}</A><BR>\n";
|
||||
} else {
|
||||
$ret .= " - <A TARGET=\"main\" HREF=\"styleinfo.bml?styleid=$sty->{'styleid'}\">$sty->{'styledes'}</A><BR>\n";
|
||||
}
|
||||
}
|
||||
|
||||
return $ret;
|
||||
|
||||
_code?><?_c <LJDEP>
|
||||
link: htdocs/customview.cgi, htdocs/admin/topics/styleinfo.bml
|
||||
</LJDEP> _c?>
|
||||
|
||||
17
livejournal/htdocs/admin/topics/screen.html
Executable file
17
livejournal/htdocs/admin/topics/screen.html
Executable file
@@ -0,0 +1,17 @@
|
||||
<HTML>
|
||||
<HEAD>
|
||||
<TITLE>Topic Directory Administration</TITLE>
|
||||
</HEAD>
|
||||
|
||||
<FRAMESET COLS="150,100%">
|
||||
<FRAME NAME="links" SRC="screen_links.bml">
|
||||
<FRAME NAME="main" SRC="screen_instructions.bml">
|
||||
</FRAMESET>
|
||||
|
||||
|
||||
</HTML>
|
||||
<!--
|
||||
<?_c <LJDEP>
|
||||
post: htdocs/admin/topics/screen_links.bml, htdocs/admin/topics/screen_instructions.bml
|
||||
</LJDEP> _c?>
|
||||
-->
|
||||
50
livejournal/htdocs/admin/topics/screen_do.bml
Executable file
50
livejournal/htdocs/admin/topics/screen_do.bml
Executable file
@@ -0,0 +1,50 @@
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%FORM);
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return $ML{'error.noremote'} unless $remote;
|
||||
|
||||
return "You don't have access to do this."
|
||||
unless LJ::remote_has_priv($remote, "topicscreencat");
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
my $ret;
|
||||
foreach my $field (keys %FORM)
|
||||
{
|
||||
my $act = $FORM{$field};
|
||||
next if ($act eq "L");
|
||||
next unless ($field =~ /^action:(\d+):(\d+)$/);
|
||||
my $topid = $1;
|
||||
my $itemid = $2;
|
||||
|
||||
if ($act eq "A") {
|
||||
my $sth = $dbh->prepare("UPDATE topic_map SET status='on', screendate=NOW(), " .
|
||||
"screenuserid=? WHERE tptopid=? AND itemid=? AND status='new'");
|
||||
$sth->execute($remote->{'userid'}, $topid, $itemid);
|
||||
if ($sth->rows) {
|
||||
$ret .= "<b>$itemid</b> approved.<br />\n";
|
||||
} else {
|
||||
$ret .= "<b>$itemid</b> already acted on.<br />\n";
|
||||
}
|
||||
}
|
||||
if ($act eq "D") {
|
||||
my $sth = $dbh->prepare("UPDATE topic_map SET status='deny', screendate=NOW(), " .
|
||||
"screenuserid=? WHERE tptopid=? AND itemid=? AND status='new'");
|
||||
$sth->execute($remote->{'userid'}, $topid, $itemid);
|
||||
if ($sth->rows) {
|
||||
$ret .= "<B>$itemid</B> denied.<BR>\n";
|
||||
} else {
|
||||
$ret .= "<B>$itemid</B> already acted on.<BR>\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return $ret;
|
||||
|
||||
_code?><?_c <LJDEP>
|
||||
# None
|
||||
</LJDEP> _c?>
|
||||
|
||||
6
livejournal/htdocs/admin/topics/screen_instructions.bml
Executable file
6
livejournal/htdocs/admin/topics/screen_instructions.bml
Executable file
@@ -0,0 +1,6 @@
|
||||
Click an item on the left and it will appear here. Read it, decide if it's applicable to the category, and then select "Approve" or "Deny".
|
||||
<!--
|
||||
<?_c <LJDEP>
|
||||
# None
|
||||
</LJDEP> _c?>
|
||||
-->
|
||||
106
livejournal/htdocs/admin/topics/screen_links.bml
Executable file
106
livejournal/htdocs/admin/topics/screen_links.bml
Executable file
@@ -0,0 +1,106 @@
|
||||
<?_code
|
||||
|
||||
my ($ret, $sth);
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
my %cataccess;
|
||||
|
||||
unless (LJ::remote_has_priv($remote, "topicscreencat", \%cataccess)) {
|
||||
return "You don't have access to do this, or you're not logged in.";
|
||||
}
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
my $and_cat_in = "";
|
||||
unless ($cataccess{'all'}) {
|
||||
my $in = join(", ", map { $dbh->quote($_); } keys %cataccess);
|
||||
$and_cat_in = "AND tl.tpcatid IN ($in)";
|
||||
}
|
||||
|
||||
$sth = $dbh->prepare("SELECT tm.tpmapid, tm.tptopid, tm.itemid FROM topic_map tm, topic_list tl WHERE tm.tptopid=tl.tptopid AND tm.status='new' $and_cat_in LIMIT 50");
|
||||
$sth->execute;
|
||||
if ($dbh->err) { return $dbh->errstr; }
|
||||
my %topic;
|
||||
while (my $map = $sth->fetchrow_hashref)
|
||||
{
|
||||
push @maps, $map;
|
||||
$topic{$map->{'tptopid'}} = undef;
|
||||
}
|
||||
|
||||
unless (@maps) {
|
||||
return "<B>Empty!</B> ... no items are awaiting approval";
|
||||
}
|
||||
|
||||
my $top_in = join(",", keys %topic);
|
||||
$sth = $dbh->prepare("SELECT tptopid, tpcatid, topname FROM topic_list WHERE tptopid IN ($top_in)");
|
||||
$sth->execute;
|
||||
if ($dbh->err) { return $dbh->errstr; }
|
||||
my %cat;
|
||||
while (my $top = $sth->fetchrow_hashref)
|
||||
{
|
||||
$topic{$top->{'tptopid'}} = $top;
|
||||
$cat{$top->{'tpcatid'}} = undef;
|
||||
}
|
||||
|
||||
my $cat_in = join(",", keys %cat);
|
||||
$sth = $dbh->prepare("SELECT tpcatid, parent, catname FROM topic_cats WHERE tpcatid IN ($cat_in)");
|
||||
$sth->execute;
|
||||
if ($dbh->err) { return $dbh->errstr; }
|
||||
while (my $cat = $sth->fetchrow_hashref)
|
||||
{
|
||||
$cat{$cat->{'tpcatid'}} = $cat;
|
||||
}
|
||||
|
||||
$ret .= "<FORM METHOD=POST ACTION=\"screen_do.bml\">";
|
||||
|
||||
foreach my $map (@maps)
|
||||
{
|
||||
my $catid = $topic{$map->{'tptopid'}}->{'tpcatid'};
|
||||
next unless ($cataccess{'all'} || $cataccess{$catid});
|
||||
&load_cats_up($catid, \%cat);
|
||||
$ret .= "<P>";
|
||||
my $fullcat;
|
||||
my $catup = $catid;
|
||||
while ($catup) {
|
||||
$fullcat = "$cat{$catup}->{'catname'} : $fullcat";
|
||||
$catup = $cat{$catup}->{'parent'};
|
||||
}
|
||||
$fullcat .= $topic{$map->{'tptopid'}}->{'topname'};
|
||||
$ret .= "<B><FONT SIZE=-1>[$fullcat]</FONT></B>";
|
||||
$ret .= "<BR><A HREF=\"/talkread.bml?itemid=$map->{'itemid'}\" TARGET=\"main\">$map->{'itemid'}</A>";
|
||||
my %opts = ("L" => "Leave", "A" => "Approve", "D" => "Deny");
|
||||
foreach (qw(L A D)) {
|
||||
$ret .= "<BR><INPUT TYPE=RADIO NAME=\"action:$map->{'tptopid'}:$map->{'itemid'}\" VALUE=\"$_\">$opts{$_}\n";
|
||||
}
|
||||
}
|
||||
|
||||
$ret .= "<P><INPUT TYPE=SUBMIT VALUE=\"Submit\"></FORM>";
|
||||
|
||||
return $ret;
|
||||
|
||||
sub load_cats_up
|
||||
{
|
||||
my $catid = shift;
|
||||
my $hashref = shift;
|
||||
$catid += 0;
|
||||
while ($catid)
|
||||
{
|
||||
unless ($hashref->{$catid}) {
|
||||
$sth = $dbh->prepare("SELECT parent, catname FROM topic_cats WHERE tpcatid=$catid");
|
||||
$sth->execute;
|
||||
my $cat = $sth->fetchrow_hashref;
|
||||
if ($cat) {
|
||||
$hashref->{$catid} = $cat;
|
||||
$catid = $cat->{'parent'}
|
||||
}
|
||||
} else {
|
||||
$catid = $hashref->{$catid}->{'parent'};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
_code?><?_c <LJDEP>
|
||||
link: htdocs/talkpost.bml
|
||||
post: htdocs/admin/topics/screen_links.bml
|
||||
</LJDEP> _c?>
|
||||
|
||||
87
livejournal/htdocs/admin/topics/screentop.bml
Executable file
87
livejournal/htdocs/admin/topics/screentop.bml
Executable file
@@ -0,0 +1,87 @@
|
||||
<?page
|
||||
title=>Screen Topics
|
||||
body<=
|
||||
|
||||
<?_code
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
my ($ret, $sth);
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
my %cataccess;
|
||||
unless (LJ::remote_has_priv($remote, "topicscreencat", \%cataccess)) {
|
||||
return "You don't have access to do this, or you're not logged in.";
|
||||
}
|
||||
my $and_cat_in = "";
|
||||
unless ($cataccess{'all'}) {
|
||||
my $in = join(", ", map { $dbh->quote($_); } keys %cataccess);
|
||||
$and_cat_in = "AND tpcatid IN ($in)";
|
||||
}
|
||||
|
||||
$sth = $dbh->prepare("SELECT tptopid, tpcatid, topname FROM topic_list WHERE status='new' $and_cat_in");
|
||||
$sth->execute;
|
||||
if ($dbh->err) { return $dbh->errstr; }
|
||||
|
||||
@new = ();
|
||||
push @new, $_ while ($_ = $sth->fetchrow_hashref);
|
||||
|
||||
unless (@new) {
|
||||
return "<B>Empty!</B> ... no topics are awaiting approval";
|
||||
}
|
||||
|
||||
$ret .= "<FORM METHOD=POST ACTION=\"screentop_do.bml\">";
|
||||
|
||||
my $count = 0;
|
||||
foreach my $new (@new)
|
||||
{
|
||||
next if (++$count > 50);
|
||||
&load_cats_up($new->{'tpcatid'}, \%cat);
|
||||
$ret .= "<P>";
|
||||
my $fullcat;
|
||||
my $catup = $new->{'tpcatid'};
|
||||
while ($catup) {
|
||||
$fullcat = "$cat{$catup}->{'catname'} : $fullcat";
|
||||
$catup = $cat{$catup}->{'parent'};
|
||||
}
|
||||
$fullcat =~ s/\s+:\s+$//;
|
||||
$ret .= "<B><FONT SIZE=-1>[$fullcat]</FONT></B>";
|
||||
$ret .= "<BR>$new->{'topname'}";
|
||||
my %opts = ("L" => "Leave", "A" => "Approve", "D" => "Deny");
|
||||
foreach (qw(L A D)) {
|
||||
$ret .= "<BR><INPUT TYPE=RADIO NAME=\"action:$new->{'tptopid'}\" VALUE=\"$_\">$opts{$_}\n";
|
||||
}
|
||||
}
|
||||
|
||||
$ret .= "<P><INPUT TYPE=SUBMIT VALUE=\"Submit\"></FORM>";
|
||||
|
||||
return $ret;
|
||||
|
||||
sub load_cats_up
|
||||
{
|
||||
my $catid = shift;
|
||||
my $hashref = shift;
|
||||
$catid += 0;
|
||||
while ($catid)
|
||||
{
|
||||
unless ($hashref->{$catid}) {
|
||||
$sth = $dbh->prepare("SELECT parent, catname FROM topic_cats WHERE tpcatid=$catid");
|
||||
$sth->execute;
|
||||
my $cat = $sth->fetchrow_hashref;
|
||||
if ($cat) {
|
||||
$hashref->{$catid} = $cat;
|
||||
$catid = $cat->{'parent'}
|
||||
}
|
||||
} else {
|
||||
$catid = $hashref->{$catid}->{'parent'};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
_code?>
|
||||
<=body
|
||||
page?><?_c <LJDEP>
|
||||
post: htdocs/admin/topics/screentop_do.bml
|
||||
</LJDEP> _c?>
|
||||
|
||||
18
livejournal/htdocs/admin/topics/screentop.html
Executable file
18
livejournal/htdocs/admin/topics/screentop.html
Executable file
@@ -0,0 +1,18 @@
|
||||
<HTML>
|
||||
<HEAD>
|
||||
<TITLE>Topic Directory Administration</TITLE>
|
||||
</HEAD>
|
||||
|
||||
<FRAMESET COLS="150,100%">
|
||||
<FRAME NAME="links" SRC="screen_links.bml">
|
||||
<FRAME NAME="main" SRC="screen_instructions.bml">
|
||||
</FRAMESET>
|
||||
|
||||
|
||||
</HTML>
|
||||
|
||||
<!--
|
||||
<?_c <LJDEP>
|
||||
link: htdocs/admin/topics/screen_links.bml, htdocs/admin/topics/screen_instructions.bml
|
||||
</LJDEP> _c?>
|
||||
-->
|
||||
49
livejournal/htdocs/admin/topics/screentop_do.bml
Executable file
49
livejournal/htdocs/admin/topics/screentop_do.bml
Executable file
@@ -0,0 +1,49 @@
|
||||
<?_code
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
unless (LJ::remote_has_priv($remote, "topicaddtopic")) {
|
||||
return "You don't have access to do this, or you're not logged in.";
|
||||
}
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
my $sth;
|
||||
|
||||
my $ret;
|
||||
|
||||
foreach my $field (keys %FORM)
|
||||
{
|
||||
next unless ($field =~ /^action:(\d+)$/);
|
||||
my $act = $FORM{$field};
|
||||
next if ($act eq "L");
|
||||
|
||||
my $topid = $1;
|
||||
|
||||
if ($act eq "A") {
|
||||
$sth = $dbh->prepare("UPDATE topic_list SET status='on' WHERE tptopid=$topid AND status='new'");
|
||||
$sth->execute;
|
||||
if ($sth->rows) {
|
||||
$ret .= "<B>$topid</B> approved.<BR>\n";
|
||||
} else {
|
||||
$ret .= "<B>$topid</B> already acted on.<BR>\n";
|
||||
}
|
||||
}
|
||||
if ($act eq "D") {
|
||||
$sth = $dbh->prepare("UPDATE topic_list SET status='deny' WHERE tptopid=$topid AND status='new'");
|
||||
$sth->execute;
|
||||
if ($sth->rows) {
|
||||
$ret .= "<B>$topid</B> denied.<BR>\n";
|
||||
} else {
|
||||
$ret .= "<B>$topid</B> already acted on.<BR>\n";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
return $ret;
|
||||
|
||||
_code?><?_c <LJDEP>
|
||||
# None
|
||||
</LJDEP> _c?>
|
||||
|
||||
12
livejournal/htdocs/admin/topics/start.bml
Executable file
12
livejournal/htdocs/admin/topics/start.bml
Executable file
@@ -0,0 +1,12 @@
|
||||
<FORM TARGET="links" ACTION="links.bml" METHOD=GET>
|
||||
Username to preview:
|
||||
<INPUT NAME="user" SIZE=15 MAXLENGTH=15>
|
||||
|
||||
<P><INPUT TYPE="SUBMIT" VALUE="Make links">
|
||||
</FORM>
|
||||
|
||||
<!--
|
||||
<?_c <LJDEP>
|
||||
post: htdocs/admin/topics/links.bml
|
||||
</LJDEP> _c?>
|
||||
-->
|
||||
111
livejournal/htdocs/admin/userlog.bml
Executable file
111
livejournal/htdocs/admin/userlog.bml
Executable file
@@ -0,0 +1,111 @@
|
||||
<?page
|
||||
title=>User Log Viewer
|
||||
head<=
|
||||
<style>
|
||||
<!--
|
||||
td.logrow {
|
||||
border: solid 1px rgb(230,230,230);
|
||||
padding: 2px;
|
||||
margin: 0px;
|
||||
}
|
||||
th.logrow {
|
||||
border: solid 1px rgb(180,180,180);
|
||||
padding: 2px;
|
||||
margin: 0px;
|
||||
text-weight: bold;
|
||||
}
|
||||
-->
|
||||
</style>
|
||||
<=head
|
||||
body<=
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw($GET $POST);
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return "<?needlogin?>" unless $remote;
|
||||
|
||||
my $err = sub {
|
||||
return "<?h1 Error h1?><?p $_[0] p?>";
|
||||
};
|
||||
|
||||
return $err->("You do not have the necessary privilege to view this page.")
|
||||
unless LJ::check_priv($remote, 'canview', 'userlog') ||
|
||||
LJ::check_priv($remote, 'canview', '*');
|
||||
|
||||
my $user = LJ::canonical_username($POST{user});
|
||||
|
||||
my $ret = <<FORM;
|
||||
<form method='post' action='userlog.bml'>
|
||||
Username: <input type='text' name='user' value='$user' maxlength='15' size='15' /> <input type='submit' value='View' />
|
||||
</form>
|
||||
FORM
|
||||
return $ret unless $user;
|
||||
|
||||
my $u = LJ::load_user($user);
|
||||
return $err->("User does not exist.")
|
||||
unless $u;
|
||||
|
||||
my $dbcr = LJ::get_cluster_reader($u);
|
||||
return $err->("Unable to get user cluster reader.")
|
||||
unless $dbcr;
|
||||
|
||||
my $sth = $dbcr->prepare('SELECT * FROM userlog WHERE userid = ? ORDER BY logtime DESC LIMIT 1000');
|
||||
$sth->execute($u->{userid});
|
||||
return $err->("Database error: " . $sth->errstr)
|
||||
if $sth->err;
|
||||
|
||||
$ret .= "<?p Latest log entries for " . LJ::ljuser($u) . ". p?>";
|
||||
$ret .= "<table style='border: solid 1px black; width: 95%;'>\n";
|
||||
$ret .= "<tr>";
|
||||
$ret .= join('', map { "<th class='logrow'>$_</th>" } ("Date and Time", "Action", "Initiator", "IP Address", "Uniq Cookie"));
|
||||
$ret .= "</tr>\n";
|
||||
|
||||
while (my $row = $sth->fetchrow_hashref) {
|
||||
my $extra = {};
|
||||
LJ::decode_url_string($row->{extra}, $extra);
|
||||
|
||||
my $action = "Action undefined for: $row->{action}";
|
||||
if ($row->{action} eq 'delete_entry') {
|
||||
$action = "Deleted entry $row->{actiontarget} via $extra->{method}";
|
||||
} elsif ($row->{action} eq 'account_create') {
|
||||
$action = "Account created";
|
||||
} elsif ($row->{action} eq 'ban_set') {
|
||||
my $u = LJ::load_userid($row->{actiontarget});
|
||||
$action = "Banned " . LJ::ljuser($u) if $u;
|
||||
} elsif ($row->{action} eq 'ban_unset') {
|
||||
my $u = LJ::load_userid($row->{actiontarget});
|
||||
$action = "Unbanned " . LJ::ljuser($u) if $u;
|
||||
} elsif ($row->{action} eq 'maintainer_add') {
|
||||
my $u = LJ::load_userid($row->{actiontarget});
|
||||
$action = "Added maintainer " . LJ::ljuser($u) if $u;
|
||||
} elsif ($row->{action} eq 'maintainer_remove') {
|
||||
my $u = LJ::load_userid($row->{actiontarget});
|
||||
$action = "Removed maintainer " . LJ::ljuser($u) if $u;
|
||||
} else {
|
||||
$action = "Unknown action ($row->{action})";
|
||||
}
|
||||
|
||||
my $time = LJ::mysql_time($row->{logtime});
|
||||
|
||||
my $actor;
|
||||
if ($row->{remoteid}) {
|
||||
my $u = LJ::load_userid($row->{remoteid});
|
||||
$actor = LJ::ljuser($u);
|
||||
} else {
|
||||
$actor = "<em>not recorded</em>";
|
||||
}
|
||||
|
||||
my $ip = $row->{ip} || "<em>not recorded</em>";
|
||||
my $uniq = $row->{uniq} || "<em>not recorded</em>";
|
||||
|
||||
$ret .= "<tr>" . join('', map { "<td class='logrow'>$_</td>" } ($time, $action, $actor, $ip, $uniq)) . "</tr>\n";
|
||||
}
|
||||
|
||||
$ret .= "</table>";
|
||||
return $ret;
|
||||
}
|
||||
_code?>
|
||||
<=body
|
||||
page?>
|
||||
Reference in New Issue
Block a user