zlax/ljr
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

init

Browse Source
This commit is contained in:
ivan
2019-02-06 00:49:12 +03:00
commit 8dbb1bb605
4796 changed files with 506072 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

104
local/htdocs/admin/console/index.bml Executable file
View 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 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?>

60
local/htdocs/admin/console/reference.bml Executable file
View File

@@ -0,0 +1,60 @@
<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 &lt;angle brackets&gt; 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> \n";
foreach my $cmdname (sort keys %LJ::Con::cmd)
{
my $cmd = $LJ::Con::cmd{$cmdname};
next if ($cmd->{'hidden'});
my $anchor = "$cmdname";
$ret .= "<a href='\#$anchor'>$cmdname</a>&nbsp;&nbsp;&nbsp; \n";
}
$ret .= "</dl><dl> \n";
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 = "$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> \n";
}
$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?>

2
local/htdocs/admin/ljr/.htaccess Normal file
View File

@@ -0,0 +1,2 @@
ExpiresActive on
ExpiresByType image/png A0000000

147
local/htdocs/admin/ljr/import-queue.bml Normal file
View File

@@ -0,0 +1,147 @@
<?page
title=><?_ml .title _ml?>
body<=
<?_code
LJ::set_active_crumb('import');
return;
_code?>
<?_code
{
my $err = sub {
my $txt = shift;
return "<?inerr " . $txt . " inerr?><br/>";
};
use strict;
use vars qw(%POST %GET);
use POSIX;
my $records_per_page = 10;
return LJ::server_down_html() if $LJ::SERVER_DOWN;
my $remote = LJ::get_remote();
return LJ::bad_input("You must be logged in to access import page.")
unless $remote;
return"<b>Error:</b> You don't have access to view import results."
unless (LJ::check_priv($remote, "siteadmin", "importresults"));
my $authas = $GET{'authas'} || $remote->{'user'};
my $u = LJ::get_authas_user($authas);
return LJ::bad_input("You could not be authenticated as the specified user.")
unless $u;
my $ret;
my $dbr;
$dbr = LJ::get_db_reader();
return $err->("Can't get database reader!") unless $dbr;
$ret = "<?h1 Очередь импорта всех пользователей h1?>\n<br/>";
my $sth1;
my $max_importid;
$sth1 = $dbr->prepare("SELECT max(importid) as mi FROM ljr_iqueue");
$sth1->execute();
if (my $r = $sth1->fetchrow_hashref) {
$max_importid = $r->{"mi"};
}
$sth1->finish;
if (!$max_importid) {
return $err->("Import queue is empty right now. Check out <a href=import-results.bml>import results</a> instead.")
}
$ret .= "<br/>Check out <a href=import-results.bml>import results</a> also.<br/>";
my $tot_pages = POSIX::floor($max_importid / $records_per_page) + 1;
my $offset = $max_importid - POSIX::floor($max_importid / $records_per_page) * $records_per_page;
my $i;
if (!defined($GET{"page"}) || int($GET{"page"}) == 0 ) {
$GET{"page"} = $tot_pages;
}
else {
$GET{"page"} = abs(int($GET{"page"}));
}
$ret .= "<br/><font size=+1>Страницы:&nbsp;&nbsp;</font><font size=+2>";
my $lindex;
my $rindex;
$lindex = $GET{"page"} + 5;
if ($lindex > $tot_pages) {
$rindex = $rindex - ($lindex - $tot_pages);
$lindex = $tot_pages;
}
$rindex = $rindex + $GET{"page"} - 5;
if ($rindex < 1) {
$lindex = $lindex + abs($rindex) - 1;
$rindex = 1;
}
for ($i = $lindex; $i >= $rindex; $i--) {
if ($i == $GET{"page"}) {
$ret .= $i . "&nbsp;";
}
else {
$ret .= "<a href=import-queue.bml?page=$i>$i</a>&nbsp;";
}
}
$ret .= "</font>";
$ret .= "<form action='import-queue.bml' method='get'>";
$ret .= "<input type=submit value='&nbsp;Обновить&nbsp;'>";
$ret .= "<input type=hidden name=page id=page value='" . $GET{"page"} . "'";
$ret .= "</form><br/><br/>";
$sth1 = $dbr->prepare(
"SELECT * FROM ljr_iqueue where importid <= " .
(($GET{"page"} - 1) * $records_per_page + $offset) .
" and importid > " .
((($GET{"page"} - 1) * $records_per_page) + $offset - $records_per_page) .
" order by priority, importid desc "
);
$sth1->execute();
$ret .= "<table border=0 cellpadding=5 cellspacing=0>";
$ret .= "<tr bgcolor=#DDDDDD>";
$ret .= "<td>Приоритет</td>";
$ret .= "<td>Номер</td>";
$ret .= "<td>Исходный<br/>сервер</td>";
$ret .= "<td>Пользователь<br/>на исходном сервере</td>";
$ret .= "<td>Протокол</td>";
$ret .= "<td>Пользователь<br/>LJ.Rossia.org</td>";
$ret .= "<td>Дата и время<br/>создания заявки</td>";
$ret .= "</tr>";
while (my $r = $sth1->fetchrow_hashref) {
$ret .= "<tr>";
$ret .= "<td>" . $r->{priority} . "</td>";
$ret .= "<td>" . $r->{importid} . "</td>";
$ret .= "<td>" . $r->{remote_site} . "</td>";
$ret .= "<td><a href=http://" . $r->{remote_site} ."/users/" . $r->{remote_user} . ">" .
$r->{remote_user} . "</a></td>";
$ret .= "<td>" . $r->{remote_protocol} . "</td>";
$ret .= "<td><a href=" . $LJ::SITEROOT . "/users/" . $r->{local_user} . ">" .
$r->{local_user} . "</a></td>";
$ret .= "<td>" . $r->{qdate} . "</td>";
$ret .= "</tr>";
$ret .= "<tr bgcolor=#DDDDDD><td colspan=10></td></tr>";
}
$ret .= "</table>";
$sth1->finish;
return $ret;
}
_code?>
<=body
page?>

203
local/htdocs/admin/ljr/import-results.bml Executable file
View File

@@ -0,0 +1,203 @@
<?page
title=><?_ml .title _ml?>
body<=
<?_code
LJ::set_active_crumb('import');
return;
_code?>
<?_code
{
my $err = sub {
my $txt = shift;
return "<?inerr " . $txt . " inerr?><br/>";
};
use strict;
use vars qw(%POST %GET);
use POSIX;
my $records_per_page = 10;
return LJ::server_down_html() if $LJ::SERVER_DOWN;
my $remote = LJ::get_remote();
return LJ::bad_input("You must be logged in to access import page.")
unless $remote;
return"<b>Error:</b> You don't have access to view import results."
unless (LJ::check_priv($remote, "siteadmin", "importresults"));
my $authas = $GET{'authas'} || $remote->{'user'};
my $u = LJ::get_authas_user($authas);
return LJ::bad_input("You could not be authenticated as the specified user.")
unless $u;
my $ret;
my $dbr;
$dbr = LJ::get_db_reader();
return $err->("Can't get database reader!") unless $dbr;
if (defined($GET{"retry"}) && int($GET{"retry"}) > 0 ) {
$ret = "<?h1 Do you really want to retry import [" . $GET{"retry"} . "]? h1?>\n<br/><br/>";
$ret .= "<a href=import-results.bml?retrydo=" . $GET{"retry"} .">Yes please</a>&nbsp;&nbsp;";
$ret .= "<a href=import-results.bml>No thanks</a>";
return $ret;
}
if (defined($GET{"retrydo"}) && int($GET{"retrydo"}) > 0 ) {
my $sth1;
$sth1 = $dbr->prepare("SELECT * FROM ljr_ihistory WHERE importid=?");
$sth1->execute($GET{"retrydo"});
my $dbh = LJ::get_db_writer();
return $err->("Can't get database writer!") unless $dbh;
my $r;
if ($r = $sth1->fetchrow_hashref) {
$sth1->finish;
return $err->("Sorry we do not have remote password for import [" . $GET{"retrydo"} . "]!")
if $r->{remote_pass} eq "";
$sth1 = $dbr->prepare("SELECT * FROM ljr_iqueue WHERE local_user=?");
$sth1->execute($r->{local_user});
if ($sth1->fetchrow_hashref) {
$dbh->do(
"update ljr_iqueue set remote_site=?, remote_user=?, remote_pass=?, remote_protocol=? " .
"where local_user=?;", undef,
$r->{remote_site}, $r->{remote_user}, $r->{remote_pass},
$r->{remote_protocol}, $r->{local_user});
return $err->($dbh->errstr) if $dbh->err;
}
else {
$dbh->do(
"insert into ljr_iqueue " .
"(remote_site, remote_user, remote_pass, remote_protocol, local_user, " .
"opt_overwrite, opt_comments, qdate, priority) VALUES " .
"(?, ?, ?, ?, ?, '0', '1', now(), 4);",
undef, $r->{remote_site}, $r->{remote_user}, $r->{remote_pass},
$r->{remote_protocol}, $r->{local_user});
return $err->($dbh->errstr) if $dbh->err;
}
$sth1->finish;
$ret = "OK. You have it.";
}
else {
return $err->("Sorry, we can't find import [" . $GET{"retrydo"} . "]!");
}
return $ret;
}
$ret = "<?h1 Импорт всех пользователей h1?>\n<br/>";
my $sth1;
my $max_importid;
$sth1 = $dbr->prepare("SELECT max(importid) as mi FROM ljr_ihistory");
$sth1->execute();
if (my $r = $sth1->fetchrow_hashref) {
$max_importid = $r->{"mi"};
}
else {
return $err->("No import ever happened.")
}
$sth1->finish;
$ret .= "<br/>Check out <a href=import-queue.bml>import queue</a> also.<br/>";
my $tot_pages = POSIX::floor($max_importid / $records_per_page) + 1;
my $offset = $max_importid - POSIX::floor($max_importid / $records_per_page) * $records_per_page;
my $i;
if (!defined($GET{"page"}) || int($GET{"page"}) == 0 ) {
$GET{"page"} = $tot_pages;
}
else {
$GET{"page"} = abs(int($GET{"page"}));
}
$ret .= "<br/><font size=+1>Страницы:&nbsp;&nbsp;</font><font size=+2>";
my $lindex;
my $rindex;
$lindex = $GET{"page"} + 5;
if ($lindex > $tot_pages) {
$rindex = $rindex - ($lindex - $tot_pages);
$lindex = $tot_pages;
}
$rindex = $rindex + $GET{"page"} - 5;
if ($rindex < 1) {
$lindex = $lindex + abs($rindex) - 1;
$rindex = 1;
}
for ($i = $lindex; $i >= $rindex; $i--) {
if ($i == $GET{"page"}) {
$ret .= $i . "&nbsp;";
}
else {
$ret .= "<a href=import-results.bml?page=$i>$i</a>&nbsp;";
}
}
$ret .= "</font>";
$ret .= "<form action='import-results.bml' method='get'>";
$ret .= "<input type=submit value='&nbsp;Обновить&nbsp;'>";
$ret .= "<input type=hidden name=page id=page value='" . $GET{"page"} . "'";
$ret .= "</form><br/><br/>";
$sth1 = $dbr->prepare(
"SELECT * FROM ljr_ihistory where importid <= " .
(($GET{"page"} - 1) * $records_per_page + $offset) .
" and importid > " .
((($GET{"page"} - 1) * $records_per_page) + $offset - $records_per_page) .
" order by importid desc "
);
$sth1->execute();
$ret .= "<table border=0 cellpadding=5 cellspacing=0>";
$ret .= "<tr bgcolor=#DDDDDD>";
$ret .= "<td>Номер</td>";
$ret .= "<td>Исходный<br/>сервер</td>";
$ret .= "<td>Пользователь<br/>на исходном сервере</td>";
$ret .= "<td>Протокол</td>";
$ret .= "<td>Пользователь<br/>LJ.Rossia.org</td>";
$ret .= "<td>Дата и время<br/>изменения<br/>статуса заявки</td>";
$ret .= "<td>Статус заявки</td>";
$ret .= "</tr>";
while (my $r = $sth1->fetchrow_hashref) {
$ret .= "<tr>";
$ret .= "<td>" . $r->{importid} . "</td>";
$ret .= "<td>" . $r->{remote_site} . "</td>";
$ret .= "<td><a href=http://" . $r->{remote_site} ."/users/" . $r->{remote_user} . ">" .
$r->{remote_user} . "</a></td>";
$ret .= "<td>" . $r->{remote_protocol} . "</td>";
$ret .= "<td><a href=" . $LJ::SITEROOT . "/users/" . $r->{local_user} . ">" .
$r->{local_user} . "</a></td>";
$ret .= "<td>" . $r->{idate} . "</td>";
$ret .= "<td>" .
($r->{istatus} ne "SUCCESSFUL" && $r->{remote_pass} ne "" ?
"<font size=-2><a href=import-results.bml?retry=$r->{importid}>retry</a>&nbsp;</font>"
: "") .
$r->{istatus} . "</td>";
$ret .= "</tr>";
$ret .= "<tr bgcolor=#DDDDDD><td colspan=10></td></tr>";
}
$ret .= "</table>";
$sth1->finish;
return $ret;
}
_code?>
<=body
page?>

81
local/htdocs/admin/memcache-keys.txt Executable file
View File

@@ -0,0 +1,81 @@
<uid> userid:<uid> == $u, (in arrayref packed form)
uidof:<user> == userid
<uid> uprop:<uid>:<propid> == scalar
<uid> tags:<uid> == { tagid => { **tag info hashref, see LJ::Tags::get_usertags** } }
<uid> sess:<uid>:<sessid> == sessions row hashref
<uid> bio:<uid> == user bio text
<uid> talktext:<cid>:<uid>:<jtalkid> == [ subject, text ] 60 min
<uid> talkprop:<uid>:<jtalkid> == { propname => $value, ... } 60 min
<uid> talk2:<uid>:<nodetype>:<nodeid> == packed data 120 min
<uid> talk2ct:<uid> == # rows for user
<uid> talkleftct:<uid> == # rows for user
<uid> logtext:<cid>:<uid>:<jitemid> == [ subject, text ] 120 min
<uid> logprop:<uid>:<jitemid> == { propname => $value, ... } 120 min
<uid> logtag:<uid>:<jitemid> == [ kwid, kwid, kwid, ... ]
<uid> log2:<uid>:<jitemid> == packed data
<uid> log2ct:<uid> == # of rows for user
<uid> log2lt:<uid> == packed data: array of recent log2 entries in rlogtime
order, for friends page, last few weeks by default
<uid> rp:<uid>:<jitemid> == scalar, the replycount value
<uid> memkwid:<uid> == hashref of 'memories' keyword ids to keywords.
<uid> dayct:<uid> == arrayref of arrayrefs (see LJ::get_daycounts)
<uid> auc:<uid>:<dom> == last ID from LJ::alloc_user_counter() for $uid/$domain
<themeid> moodthemedata:<themeid> = { $moodid => { 'pic' => $pic, 'w' => $w, 'h' => $h } }
<uid> s1overr:<uid> == overrides for a given user
<uid> s1uc:<uid> == s1usercache row hashref
s1pubstyc == hashref keyed on styleid with values being rows from s1style table
<styleid> s1styc:<styleid> == s1stylecache row hashref, 30 minutes
<styleid> s1style:<styleid> == hashref of s1style row, without formatdata
<styleid> s1style_all:<styleid> == hashref of s1style row, including formatdata
<styleid> s1stylemap: <styleid> == userid who owns the given styleid
<styleid> s2sl:<styleid> == hashref of s2stylelayers { type => s2lid }
<styleid> s2s:<styleid> == hashref of s2styles row
s2publayers == memoize LJ::S2::get_public_layers for 10 mins
<layerid> s2lo:<layerid> == userid of the owner of this layer
<layerid> s2c:<layerid> == arrayref; [ compile time, compiled data (or 0 meaning no data) ]
<uid> checkfriends:<uid>:<mask> == scalar maxupdate, expires after refresh interval
<uid> frgmask:<uid>:<uid_friend> -- scalar numeric mask, 15 minutes
<uid> fgrp:<uid> == packed data, friendgroup rows for a given user
<uid> friends:<uid> == packed data, friends rows for a user
<uid> friendofs:<uid> == packed data, friendofs for a user
<uid> tu:<uid> == packed number: unixtime when user last updated
<uid> te:<uid> == packed number: unixtime when user last updated or edited
rss:<uid> == anonymous RSS page (text/html + last-modified)
blob:timeupdate == array of recently updated userids, few weeks. 1 min expire
popsyn == 100 most read syndicated accounts [user, userid, synurl, numreaders], 1 hour
sysban:ip == hashref of ip => unix expiration time
sysban:uniq == hashref of uniq => unix expiration time
<picid> userpic.<picid> == hashref-as-arrayref (ARRAYFMT: 'userpic' in LJ::MemCache)
<uid> upicinf:<uid> == packed data, userpic keywords
<uid> upiccom:<uid> == packed data, userpic comments
<uid> upicurl:<uid> == packed data, userpic urls
<picid> mogp.up.<picid> == arrayref of paths (URLs)
rate_eperr:<email_address> == rate limiting errors sent via email for email gateway
rate:tracked:<userid> == cluster tracking on login, posts, and comments
ml.<lang>.<dmid>.<code>
includefile:<name> == text of BML include file
<intid> introw:<intid> -- arrayref of [ $intid, $interest, $intcount ]
<uid> intids:<uid> -- arrayref of intids for this userid
<uid> rel:<uid>:<targetid>:<rel> == [{0|1}, as_of_time]
<uid> relmodu:<uid>:<rel> == as_of_time, updated when rel edges of uid change
<targetid> relmodt:<targetid>:<rel> == as_of_time, updated when rel edges of targetid change
<uid> memct:<uid> -- number of memories user has
<uid> lastcomm:<uid> -- id of the last comment the user posted via quickreply

171
local/htdocs/admin/memcache.bml Executable file
View File

@@ -0,0 +1,171 @@
<?_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 'finduser' priv." unless LJ::check_priv($u, "finduser");
# 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&amp;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..60) {
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?>

282
local/htdocs/admin/memcache_view.bml Executable file
View File

@@ -0,0 +1,282 @@
<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, "finduser"));
# 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,
'talktext:' => 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 ($rlogtime, $posterid, $eventtime, $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);
}
if ($key =~ /^te:/) {
$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;
}
#my $docurl = 'http://cvs.livejournal.org/browse.cgi/livejournal/doc/raw/memcache-keys.txt?rev=.&content-type=text/x-cvsweb-markup';
#my $docurl = 'http://cvs-ljr.lenin.ru/cgi-bin/viewvc.cgi/LJR/livejournal/doc/raw/memcache-keys.txt?view=markup';
my $docurl = 'http://lj.rossia.org/admin/memcache-keys.txt';
$ret .= "<p>Enter your memcache query(-ies) below.</p>";
$ret .= "<p>Here\'s the <a href='$docurl'>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>

56
local/htdocs/admin/netstat.bml Executable file
View File

@@ -0,0 +1,56 @@
<html>
<head><title>Netstat</title>
<body>
<?_code
use strict;
# only logged in users:
my $u = LJ::get_remote();
return "You must be logged in to view this tool." unless $u;
return "You don't have 'finduser' priv." unless LJ::check_priv($u, "finduser");
# view load average
##my $uptime = ` top -b |head -12 `;
my $uptime = `uptime`;
# but hide uptime :)
my @uptime = split(/,\s*/, $uptime);
@uptime = splice(@uptime, 3);
$uptime = join(", ", @uptime);
# netstat
my $netstat0 = `nice netstat -tanW `;
my $ip = '80.84.69.51';
my $netstat1 = `echo "$netstat0" | grep ':8' | awk '{print \$6}' | sort | uniq -c `;
my $netstat2 = `echo "$netstat0" |grep -v TIME_WAIT |grep "0 127.0.0.2:8" |grep -v LISTEN | sort -k 5 `;
my $netstat3 = `echo "$netstat0" |grep -v TIME_WAIT |grep $ip:80 |grep -v LISTEN | sort -k 5 `;
# but hide IP
$netstat3 =~ s/$ip/" lj.rossia.org"/eg;
my $netstat = $netstat1 . "\n" . $netstat2 . "\n" . $netstat3 ;
# htmt
my $ret = $uptime ;
$ret = $ret . " <a href='http://lj.rossia.org/1488_server-status_'>requests</a>";
$ret = "<pre>" . $ret . "\n" . $netstat . "</pre>";
return $ret;
_code?>
</body>
</html>

339
local/htdocs/admin/priv/index.bml Executable file
View File

@@ -0,0 +1,339 @@
<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='./'>&lt;&lt;</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&amp;viewarg=$arg'>$arg</a></td></tr>\n";
} else {
$ret .= "<td>&nbsp;</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=\"./\">&lt;&lt;</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>";
# $pcode is the name of the privilege list they're looking at, and $FORM{'viewarg'} is
# the argument in particular they care about
unless ($prec->{'is_public'} || remote_can_grant($remote, $pcode, $FORM{'viewarg'})) {
$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'}&amp;viewarg=$_->{'arg'}\">$_->{'arg'}</a></td></tr>\n";
} else {
$ret .= "<td>&nbsp;</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?>