# Memcache view

Error: You don't have access to viewing memcache info." unless (LJ::check_priv($remote, "finduser")); # unless (LJ::check_priv($remote, "siteadmin", "memcacheview")); return "Error: 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 .= "Data: "; my $dumper = Data::Dumper->new([$val],["Value"]); $dumper->Terse(1); $dumper->Indent(2); my $d = $dumper->Dump(); $ret.= "

    " . LJ::ehtml($d) . "

"; 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 .= "

Key: $key
"; unless ($sock) { $ret .= "Error: Could not connect to server

"; next; } if ($POST{'sock'}) { $ret .= "Socket: $sock
"; } my $hashkey = $get_hashkey->($key); if ($hashkey) { $ret .= "Hashkey: $hashkey
"; } my $pars = defined($hashkey) ? [$hashkey, $key] : $key; my $val = LJ::MemCache::get($pars); unless (defined $val) { $ret .= "Data: not found"; next; } $display->($key, $val); $ret .= ""; } 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 .= "

Enter your memcache query(-ies) below.

"; $ret .= "

Here\'s the reference of key names.

"; $ret .= "

Shortcuts:

> #username -> userid
> ##username -> cid:userid
> (number) -> number/256

"; $ret .= ""; $ret .= " "; $ret .= "

" . LJ::html_check({ 'type' => 'check', 'name' => 'sock', 'id' => 'sock' }); $ret .= "Show host/port per key.

"; $ret .= ""; return $ret; _code?>