Помощь - Поиск - Участники - Календарь
Полная Версия: обещанный скрипт
Real4X Forum > Real4X > Kнига жалоб и предложений
Korsar
Вот.
файлик servers.list -- каким он был во время отладки
QUOTE
195.201.55.222
217.151.226.29:26778
217.151.226.29:26777
195.208.161.120:26777
195.19.9.143:26778
195.19.9.143:26777


вот сам скрипт:

CODE

#!/usr/bin/perl

use warnings;
use IO::Socket;

$CONTENT_HEADER = 0;
$HTML_HEADER    = 0;

$SRV_LIST = 'servers.list';

&html_header();

open (SRV, $SRV_LIST);
while (<SRV>) {
 &CheckServer ($_);
 print "<hr>\n";
}
close SRV;

&html_end();
exit(0);

sub CheckServer {
  my ($src, $srvInfo, $remote, $hostaddr, $hostport, $response, $h, $m, $s);
  $srv = shift @_;
  $srvInfo = 'CB8B8B8Va21a81a151CVfVCCCva16';
  local $, = undef;
  local $\ = undef;

  if ( $srv =~ /([\d\.]+)(:(\d+)|)/ ) {
     $hostaddr = $1;
     $hostport = $3;
  } else {
     return 0;
  }

  $hostport = 26777 unless $hostport;
 
  print "\n<b>" . $hostaddr . ':' . $hostport . '</b>';

  if ($remote = IO::Socket::INET->new(Proto    => 'TCP',
                                      PeerAddr => $hostaddr,
                                      PeerPort => $hostport,
                                      Timeout  => '3')) {

     binmode $remote;
     $remote->autoflush(1);

     print $remote chr(3);
     read  $remote, $response, 1+1+2+4+21+81+151+1+4+4+4+1+1+1+2+16;
     close $remote;

     my ($f, $vN, $vM2, $vM1, $gen, $cprt, $gname, $gmemo, $gtype, $gsize, $gtimescale,
        $planets, $maxp, $regp, $online, $ovrd, $gdate) = (unpack $srvInfo, $response);

     $\ = "<br>\n";

     my @gal = qw/Noise Constellations Spiral Rounds/;

     if ($f == 4) {
        $h = int ($gtimescale);
        $s = ($gtimescale - $h) * 60*60;
        $m = int ($s / 60);
        $s = $s - $m * 60;

        print " - <font color=green>Online</font>";
        print "Net version: $vN Game version: $vM1$vM2";
        print 'Generation: ' , $gen;
        print '(c): ', &stripZ($cprt);
        print 'Game Name: ', &stripZ($gname);
        print 'Game Memo: ', &stripZ($gmemo);
        print 'Galaxy Type: ', $gal[$gtype];
        print "Galaxy Size: $gsize x $gsize LY";
        printf ("Time Scale: 1 game year = %02d:%02d:%02d<br>\n", $h, $m, $s);
        print "Planets: $planets";
        print "Max Players: $maxp";
        print "Reg. Players: $regp";
        print "Online players: $online";
        print "Overdraft: $ovrd";
        print 'Galaxy Date: ', &stripZ($gdate);
     } else {
        print " - <font color=red>Bad answer from server</font>\n";
     }
  } else {
     print " - <font color=red>Not responding</font>\n";
  }
}

sub stripZ {
  my $s = shift @_;
  my $z = index ($s, chr(0));
  if ($z < 0) {
     return $s;
  } else {
     return substr ($s, 0, $z);
  }
}

sub content_header {
   return 0 if $CONTENT_HEADER;

   print "Content-type: text/html\n";
   if ($TALK_COOKIE) {
       print "$TALK_COOKIE";
   }
   print "\n";
   $CONTENT_HEADER = 1;
}

sub print_meta {
   print "<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=windows-1251\">\n";
   print "<META HTTP-EQUIV=\"Pragma\" CONTENT=\"no-cache\">\n";
}

sub html_header {
   return 0 if $HTML_HEADER;
   &content_header;
   print "<HTML><HEAD>\n";
   print "<TITLE>Real4X: Servers status</TITLE>\n";
   &print_meta();
   print "</HEAD>\n";
   print "<BODY>\n";
   print "<HR><center>Current games:</center><hr>\n";
   $HTML_HEADER = 1;
}

sub html_end {
   print "</BODY></HTML>\n";
}
-=AVP=-
извини за глупый вопрос rolleyes.gif
а куда его писать нужно? unsure.gif
Weonard
2 AVP: мдя.... В script.pl допустим... В cgi-bin c правами запуска.
2 *: Я его за*, ттьфу... Задолбуё.. тьфу... Я не думал, что он такой здоровый....
Ой блин... Ну да ладно... Посмотрим, смогу ли я его в ПХП портировать... Немного стремно... Разобраться тока надо.
Alex
QUOTE(Weonard @ Jun 26 2003, 09:15 AM)
Ой блин... Ну да ладно... Посмотрим, смогу ли я его в ПХП портировать... Немного стремно... Разобраться тока надо.

Народ будет тебе благодарен, а то что-то мне самому лень.
Korsar
QUOTE
2 *: Я его за*, ттьфу... Задолбуё.. тьфу... Я не думал, что он такой здоровый....

А скопировать нельзя было?
Korsar
вот что у меня выдает о питерском:
QUOTE

Current games:
195.201.55.222:26777 - Online
Net version: 10001001 Game version: 0110100010001001
Generation: 3230217947
©: 2000 Real4X-250
Game Name: RealSPb 13
Game Memo: Сервер Санкт-Петербург (http://real4x.nm.ru)
Galaxy Type: Constellations
Galaxy Size: 3000 x 3000 LY
Time Scale: 1 game year = 09:36:00
Planets: 1500
Max Players: 150
Reg. Players: 73
Online players: 14
Overdraft: 30
Galaxy Date: 3101\06\02 06
Weonard
2 Корсар, я о том, что обработка немеренная. Я думал: послал запрос(нормальный) - получил ответ(в тексте)...А тут чуть ли не хэши генерить нада...
Korsar
для уменьшения трафика используются битовые поля, в крайнем случае -- двоичные данные.
Формат ясен по строке
CODE
$srvInfo = 'CB8B8B8Va21a81a151CVfVCCCva16';


прочитай в доке по Перлу описание pack/unpack -- и все станет понятным, порядок переменных тоже виден в
CODE
my ($f, $vN, $vM2, $vM1, $gen, $cprt, $gname, $gmemo, $gtype, $gsize, $gtimescale,
       $planets, $maxp, $regp, $online, $ovrd, $gdate) = (unpack $srvInfo, $response);
Weonard
А что иммено делают пак\унпак? Наверное есть альтернатива на ПХП...
Korsar
QUOTE
unpack TEMPLATE,EXPR

unpack does the reverse of pack: it takes a string and expands it out into a list of values. (In scalar context, it returns merely the first value produced.)

The string is broken into chunks described by the TEMPLATE. Each chunk is converted separately to a value. Typically, either the string is a result of pack, or the bytes of the string represent a C structure of some kind.

The TEMPLATE has the same format as in the pack function. Here's a subroutine that does substring:

    sub substr {
        my($what,$where,$howmuch) = @_;
        unpack(\"x$where a$howmuch\", $what);
    }

and then there's

    sub ordinal { unpack(\"c\",$_[0]); } # same as ord()

In addition to fields allowed in pack(), you may prefix a field with a % to indicate that you want a -bit checksum of the items instead of the items themselves. Default is a 16-bit checksum. Checksum is calculated by summing numeric values of expanded values (for string fields the sum of ord($char) is taken, for bit fields the sum of zeroes and ones).

For example, the following computes the same number as the System V sum program:

    $checksum = do {
        local $/;  # slurp!
        unpack(\"%32C*\",<>) % 65535;
    };

The following efficiently counts the number of set bits in a bit vector:

    $setbits = unpack(\"%32b*\", $selectmask);

The p and P formats should be used with care. Since Perl has no way of checking whether the value passed to unpack() corresponds to a valid memory location, passing a pointer value that's not known to be valid is likely to have disastrous consequences.

If the repeat count of a field is larger than what the remainder of the input string allows, repeat count is decreased. If the input string is longer than one described by the TEMPLATE, the rest is ignored.

See pack for more examples and notes.


QUOTE
pack TEMPLATE,LIST

Takes a LIST of values and converts it into a string using the rules given by the TEMPLATE. The resulting string is the concatenation of the converted values. Typically, each converted value looks like its machine-level representation. For example, on 32-bit machines a converted integer may be represented by a sequence of 4 bytes.

The TEMPLATE is a sequence of characters that give the order and type of values, as follows:

    a  A string with arbitrary binary data, will be null padded.
    A  An ASCII string, will be space padded.
    Z  A null terminated (asciz) string, will be null padded.

    b  A bit string (ascending bit order inside each byte, like vec()).
    B  A bit string (descending bit order inside each byte).
    h  A hex string (low nybble first).
    H  A hex string (high nybble first).

    c  A signed char value.
    C  An unsigned char value.  Only does bytes.  See U for Unicode.

    s  A signed short value.
    S  An unsigned short value.
          (This 'short' is _exactly_ 16 bits, which may differ from
          what a local C compiler calls 'short'.  If you want
          native-length shorts, use the '!' suffix.)

    i  A signed integer value.
    I  An unsigned integer value.
          (This 'integer' is _at_least_ 32 bits wide.  Its exact
          size depends on what a local C compiler calls 'int',
          and may even be larger than the 'long' described in
          the next item.)

    l  A signed long value.
    L  An unsigned long value.
          (This 'long' is _exactly_ 32 bits, which may differ from
          what a local C compiler calls 'long'.  If you want
          native-length longs, use the '!' suffix.)

    n  An unsigned short in \"network\" (big-endian) order.
    N  An unsigned long in \"network\" (big-endian) order.
    v  An unsigned short in \"VAX\" (little-endian) order.
    V  An unsigned long in \"VAX\" (little-endian) order.
          (These 'shorts' and 'longs' are _exactly_ 16 bits and
          _exactly_ 32 bits, respectively.)

    q  A signed quad (64-bit) value.
    Q  An unsigned quad value.
          (Quads are available only if your system supports 64-bit
          integer values _and_ if Perl has been compiled to support those.
          Causes a fatal error otherwise.)

    f  A single-precision float in the native format.
    d  A double-precision float in the native format.

    p  A pointer to a null-terminated string.
    P  A pointer to a structure (fixed-length string).

    u  A uuencoded string.
    U  A Unicode character number.  Encodes to UTF-8 internally.
        Works even if C is not in effect.

    w  A BER compressed integer.  Its bytes represent an unsigned
        integer in base 128, most significant digit first, with as
        few digits as possible.  Bit eight (the high bit) is set
        on each byte except the last.

    x  A null byte.
    X  Back up a byte.
    @  Null fill to absolute position.

The following rules apply:
Each letter may optionally be followed by a number giving a repeat count. With all types except a, A, Z, b, B, h, H, and P the pack function will gobble up that many values from the LIST. A * for the repeat count means to use however many items are left, except for @, x, X, where it is equivalent to 0, and u, where it is equivalent to 1 (or 45, what is the same).

When used with Z, * results in the addition of a trailing null byte (so the packed result will be one longer than the byte length of the item).

The repeat count for u is interpreted as the maximal number of bytes to encode per line of output, with 0 and 1 replaced by 45.

The a, A, and Z types gobble just one value, but pack it as a string of length count, padding with nulls or spaces as necessary. When unpacking, A strips trailing spaces and nulls, Z strips everything after the first null, and a returns data verbatim. When packing, a, and Z are equivalent.

If the value-to-pack is too long, it is truncated. If too long and an explicit count is provided, Z packs only $count-1 bytes, followed by a null byte. Thus Z always packs a trailing null byte under all circumstances.

Likewise, the b and B fields pack a string that many bits long. Each byte of the input field of pack() generates 1 bit of the result. Each result bit is based on the least-significant bit of the corresponding input byte, i.e., on ord($byte)%2. In particular, bytes \"0\" and \"1\" generate bits 0 and 1, as do bytes \"\0\" and \"\1\".

Starting from the beginning of the input string of pack(), each 8-tuple of bytes is converted to 1 byte of output. With format b the first byte of the 8-tuple determines the least-significant bit of a byte, and with format B it determines the most-significant bit of a byte.

If the length of the input string is not exactly divisible by 8, the remainder is packed as if the input string were padded by null bytes at the end. Similarly, during unpack()ing the ``extra'' bits are ignored.

If the input string of pack() is longer than needed, extra bytes are ignored. A * for the repeat count of pack() means to use all the bytes of the input field. On unpack()ing the bits are converted to a string of \"0\"s and \"1\"s.

The h and H fields pack a string that many nybbles (4-bit groups, representable as hexadecimal digits, 0-9a-f) long.

Each byte of the input field of pack() generates 4 bits of the result. For non-alphabetical bytes the result is based on the 4 least-significant bits of the input byte, i.e., on ord($byte)%16. In particular, bytes \"0\" and \"1\" generate nybbles 0 and 1, as do bytes \"\0\" and \"\1\". For bytes \"a\"..\"f\" and \"A\"..\"F\" the result is compatible with the usual hexadecimal digits, so that \"a\" and \"A\" both generate the nybble 0xa==10. The result for bytes \"g\"..\"z\" and \"G\"..\"Z\" is not well-defined.

Starting from the beginning of the input string of pack(), each pair of bytes is converted to 1 byte of output. With format h the first byte of the pair determines the least-significant nybble of the output byte, and with format H it determines the most-significant nybble.

If the length of the input string is not even, it behaves as if padded by a null byte at the end. Similarly, during unpack()ing the ``extra'' nybbles are ignored.

If the input string of pack() is longer than needed, extra bytes are ignored. A * for the repeat count of pack() means to use all the bytes of the input field. On unpack()ing the bits are converted to a string of hexadecimal digits.

The p type packs a pointer to a null-terminated string. You are responsible for ensuring the string is not a temporary value (which can potentially get deallocated before you get around to using the packed result). The P type packs a pointer to a structure of the size indicated by the length. A NULL pointer is created if the corresponding value for p or P is undef, similarly for unpack().

The / template character allows packing and unpacking of strings where the packed structure contains a byte count followed by the string itself. You write length-item/string-item.

The length-item can be any pack template letter, and describes how the length value is packed. The ones likely to be of most use are integer-packing ones like n (for Java strings), w (for ASN.1 or SNMP) and N (for Sun XDR).

The string-item must, at present, be \"A*\", \"a*\" or \"Z*\". For unpack the length of the string is obtained from the length-item, but if you put in the '*' it will be ignored.

    unpack 'C/a', \"\04Gurusamy\";        gives 'Guru'
    unpack 'a3/A* A*', '007 Bond  J ';  gives (' Bond','J')
    pack 'n/a* w/a*','hello,','world';  gives \"\000\006hello,\005world\"

The length-item is not returned explicitly from unpack.

Adding a count to the length-item letter is unlikely to do anything useful, unless that letter is A, a or Z. Packing with a length-item of a or Z may introduce \"\000\" characters, which Perl does not regard as legal in numeric strings.

The integer types s, S, l, and L may be immediately followed by a ! suffix to signify native shorts or longs--as you can see from above for example a bare l does mean exactly 32 bits, the native long (as seen by the local C compiler) may be larger. This is an issue mainly in 64-bit platforms. You can see whether using ! makes any difference by

        print length(pack(\"s\")), \" \", length(pack(\"s!\")), \"\n\";
        print length(pack(\"l\")), \" \", length(pack(\"l!\")), \"\n\";

i! and I! also work but only because of completeness; they are identical to i and I.

The actual sizes (in bytes) of native shorts, ints, longs, and long longs on the platform where Perl was built are also available via the Config manpage:

      use Config;
      print $Config{shortsize},    \"\n\";
      print $Config{intsize},      \"\n\";
      print $Config{longsize},    \"\n\";
      print $Config{longlongsize}, \"\n\";

(The $Config{longlongsize} will be undefine if your system does not support long longs.)

The integer formats s, S, i, I, l, and L are inherently non-portable between processors and operating systems because they obey the native byteorder and endianness. For example a 4-byte integer 0x12345678 (305419896 decimal) be ordered natively (arranged in and handled by the CPU registers) into bytes as

        0x12 0x34 0x56 0x78    # big-endian
        0x78 0x56 0x34 0x12    # little-endian

Basically, the Intel and VAX CPUs are little-endian, while everybody else, for example Motorola m68k/88k, PPC, Sparc, HP PA, Power, and Cray are big-endian. Alpha and MIPS can be either: Digital/Compaq used/uses them in little-endian mode; SGI/Cray uses them in big-endian mode.

The names `big-endian' and `little-endian' are comic references to the classic ``Gulliver's Travels'' (via the paper ``On Holy Wars and a Plea for Peace'' by Danny Cohen, USC/ISI IEN 137, April 1, 1980) and the egg-eating habits of the Lilliputians.

Some systems may have even weirder byte orders such as

        0x56 0x78 0x12 0x34
        0x34 0x12 0x78 0x56

You can see your system's preference with

        print join(\" \", map { sprintf \"%#02x\", $_ }
                            unpack(\"C*\",pack(\"L\",0x12345678))), \"\n\";

The byteorder on the platform where Perl was built is also available via the Config manpage:

        use Config;
        print $Config{byteorder}, \"\n\";

Byteorders '1234' and '12345678' are little-endian, '4321' and '87654321' are big-endian.

If you want portable packed integers use the formats n, N, v, and V, their byte endianness and size is known. See also the perlport manpage.

Real numbers (floats and doubles) are in the native machine format only; due to the multiplicity of floating formats around, and the lack of a standard ``network'' representation, no facility for interchange has been made. This means that packed floating point data written on one machine may not be readable on another - even if both use IEEE floating point arithmetic (as the endian-ness of the memory representation is not part of the IEEE spec). See also the perlport manpage.

Note that Perl uses doubles internally for all numeric calculation, and converting from double into float and thence back to double again will lose precision (i.e., unpack(\"f\", pack(\"f\", $foo)) will not in general equal $foo).

If the pattern begins with a U, the resulting string will be treated as Unicode-encoded. You can force UTF8 encoding on in a string with an initial U0, and the bytes that follow will be interpreted as Unicode characters. If you don't want this to happen, you can begin your pattern with C0 (or anything else) to force Perl not to UTF8 encode your string, and then follow this with a U* somewhere in your pattern.

You must yourself do any alignment or padding by inserting for example enough 'x'es while packing. There is no way to pack() and unpack() could know where the bytes are going to or coming from. Therefore pack (and unpack) handle their output and input as flat sequences of bytes.

A comment in a TEMPLATE starts with # and goes to the end of line.

If TEMPLATE requires more arguments to pack() than actually given, pack() assumes additional \"\" arguments. If TEMPLATE requires less arguments to pack() than actually given, extra arguments are ignored.

Examples:

    $foo = pack(\"CCCC\",65,66,67,68);
    # foo eq \"ABCD\"
    $foo = pack(\"C4\",65,66,67,68);
    # same thing
    $foo = pack(\"U4\",0x24b6,0x24b7,0x24b8,0x24b9);
    # same thing with Unicode circled letters

    $foo = pack(\"ccxxcc\",65,66,67,68);
    # foo eq \"AB\0\0CD\"

    # note: the above examples featuring \"C\" and \"c\" are true
    # only on ASCII and ASCII-derived systems such as ISO Latin 1
    # and UTF-8.  In EBCDIC the first example would be
    # $foo = pack(\"CCCC\",193,194,195,196);

    $foo = pack(\"s2\",1,2);
    # \"\1\0\2\0\" on little-endian
    # \"\0\1\0\2\" on big-endian

    $foo = pack(\"a4\",\"abcd\",\"x\",\"y\",\"z\");
    # \"abcd\"

    $foo = pack(\"aaaa\",\"abcd\",\"x\",\"y\",\"z\");
    # \"axyz\"

    $foo = pack(\"a14\",\"abcdefg\");
    # \"abcdefg\0\0\0\0\0\0\0\"

    $foo = pack(\"i9pl\", gmtime);
    # a real struct tm (on my system anyway)

    $utmp_template = \"Z8 Z8 Z16 L\";
    $utmp = pack($utmp_template, @utmp1);
    # a struct utmp (BSDish)

    @utmp2 = unpack($utmp_template, $utmp);
    # \"@utmp1\" eq \"@utmp2\"

    sub bintodec {
        unpack(\"N\", pack(\"B32\", substr(\"0\" x 32 . shift, -32)));
    }

    $foo = pack('sx2l', 12, 34);
    # short 12, two zero bytes padding, long 34
    $bar = pack('s@4l', 12, 34);
    # short 12, zero fill to position 4, long 34
    # $foo eq $bar

The same template may generally also be used in unpack().
Weonard
/([\d\.]+)(sad.gif\d+)|)/
От такого шаблончика сдохнуть можно.
Просче спросить ЧТо надо сказать серверу что бы тот хоть что-то ответил?*я имею ввиду хоть год сказал...
С синтаксисом перла можно и в больницу попасть...
Korsar
CODE
 if ( $srv =~ /([\d\.]+)(:(\d+)|)/ ) {
    $hostaddr = $1;
    $hostport = $3;
 } else {
    return 0;
 }


очень просто: первое число до двоеточия будт $hostaddr, после двоеточия -- $hostport
Если нет двоеточия, то $hostport будет пустым и ниже присвоится по умолчанию 26777
Alex
Вот решил сделать держателям серверов (а значит и всем игрокам) подарок к Новому Году и Рождеству, и перегнал этот полезный скриптик на php, пользуйтесь на благо Реала:
CODE
<?php
function trim0 ($s) {
 $z = strpos ($s, chr(0));
 if ($z < 0) return $s;
        else return substr ($s, 0, $z);
}

$fp = fsockopen("127.0.0.1",26777,$errno, $errstr, 30);
if ($fp) {
 $k=fwrite($fp, chr(3));
 $response = fread($fp,  1+1+2+4+21+81+151+1+4+4+4+1+1+1+2+16);
 fclose($fp);

$res = unpack("Cf/H2vN/H2vM2/H2vM1/Vgen/a21cprt/a81gname/a151gmemo/Cgtype/Vgsize/fgtimescale/Vplanets/Cmaxp/Cregp/Conline/vovrd/a16gdate",$response);
$gal  = array("Noise","Constellations ","Spiral ","Rounds");
$gl = $gal[$res[gtype]];

if ($res[f] == 4) {
 $h = (int) $res[gtimescale];
 $s = ($res[gtimescale] - $h) * 60*60;
 $m = (int) $s / 60;
 $s = (int) $s - $m * 60;
$res[vN]=DecBin(HexDec($res[vN]));
$res[vM2]=DecBin(HexDec($res[vM2]));
$res[vM1]=DecBin(HexDec($res[vM1]));
$res[gen]=DecHex($res[gen]);
$res[cprt] = trim0($res[cprt]);
$res[gname] = trim0($res[gname]);
$res[gmemo] = trim0($res[gmemo]);
$res[gdate] = trim0($res[gdate]);

echo "Net version: $res[vN] Game version: $res[vM1].$res[vM2]<br>";
echo "Generation: $res[gen]<br>";
echo "(c): $res[cprt]<br>";
echo "Game Name: $res[gname]<br>";
echo "Game Memo: $res[gmemo]<br>";
echo "Galaxy Type: $gl<br>";
echo "Galaxy Size: $res[gsize] x $res[gsize] LY<br>";
echo "Time Scale: 1 game year = $h:$m:$s<br>";
echo "Planets: $res[planets]<br>";
echo "Max Players: $res[maxp]<br>";
echo "Reg. Players: $res[regp]<br>";
echo "Online players: $res[online]<br>";
echo "Overdraft: $res[ovrd]<br>";
echo "Galaxy Date: $res[gdate]<br>";
}
}
?>
Alex
Неплохо бы этот топик переместить в более соответствующий раздел (Q & A).
Можно его почистить от длинных справок по перлу, а может и не стоит (мне они слегка пригодились).
WildCat
Спасибо, Алекс!!!
А то некоторые только и способны на то, чтобы ворчать: "стремно", "стремно"..а кто-то дело делает! ;-р

Лучше в Книгу жалоб и предложений перенесу.

чистить не буду, вдруг кому-то и вравду понадобится.
Warrior of Justice
Ну... раз пошла такая пьянка, вот такой скрипт юзаю я. Хорош тем, что эмулирует стандартный @pinfo (кто знает - тот поймет). Я уж не буду расписывать настройки - надеюсь и так все понятно. Но смысл в том, что скрипт следит за состоянием партии и если что стучит в бубен (т.е. на почту). Меж прочим - боевой скрипт smile.gif

CODE
#!/usr/local/bin/php
<?
define('USE_SOCKS', 0);

ini_alter("include_path", "/usr/local/lib/php");

if (!USE_SOCKS)
{
    include_once 'PEAR.php';
    include_once 'Net/Socket.php';
}

$servers = Array(
    Array(    'Alias' => 'Islands', 'AdminMail' => 'ihsoft@mail.ru; admin@real4x.ru',
 'Host' => 'user26.asprex.ru', 'Port' => 27000,
 'StatFile' => '../servers/Islands/pinfo.txt')
);

$srvInfo = 'C4/Vgeneration/a21copyright/a81name/a151notes/Cgtype/Vgsize/fgtimescale/Vplanets/Cmaxp/Cregp/Conline/v/a16date';
$galTypes = Array('Noise', 'Constellations', 'Spiral', 'Rounds');

function mailStatus($host, $down)
{
    $fName = 'errors/'.$host['Alias'].'.err';
    $strSubj = '';
    $strMsg = '';
    if ($down)
    {
 $file = @fopen($fName, 'r');
 if (!$file)
 {
     $strSubj = 'Server down: '.$host['Host'].':'.$host['Port'];
     $file = fopen($fName, 'w');
     fputs($file, date("m/d/y H:i:s"));
     fclose($file);
 }
    }
    else
    {
 $file = @fopen($fName, 'r');
 if ($file)
 {
     $strSubj = 'Server online: '.$host['Host'].':'.$host['Port'];
     $strMsg = 'Was down since '.fgets($file, 100);
     fclose($file);
     unlink($fName);
 }
    }
    if ($strSubj) mail($host['AdminMail'], $strSubj, $strMsg, "From: CheckServer\n");
}

function stripZ($str)
{
    $pos = strpos($str, "<!--POST BOX-->");
    if ($pos === false) return $str;
    else return substr($str, 0, $pos);
}

function checkServer($host)
{
    global $srvInfo, $galTypes;

    if (USE_SOCKS)
    {
 if (($sock = socket_create (AF_INET, SOCK_STREAM, 0)) < 0)
 {
     mailStatus($host, true);
     echo "socket_create() failed: reason: " . socket_strerror ($sock) . "\n";
     return;
 }

 if (($ret = socket_connect($sock, $host['Host'], $host['Port'])) < 0)
 {
     mailStatus($host, true);
     echo "socket_connect() failed: reason: " . socket_strerror ($ret) . "\n";
     return;
 }

 socket_write($sock, chr(3), 1);
 $result = socket_read($sock, 1+1+2+4+21+81+151+1+4+4+4+1+1+1+2+16);
 socket_close($sock);
    }
    else
    {
 if (PEAR::isError($sock = new Net_Socket()))
 {
     mailStatus($host, true);
     echo "Unable to create a socket object\n";
     return;
 }
 if (PEAR::isError($sock->connect($host['Host'], $host['Port'])))
 {
     mailStatus($host, true);
     echo "Unable to open socket\n";
     return;
 }

 $sock->write(chr(3));
 $result = $sock->read(1+1+2+4+21+81+151+1+4+4+4+1+1+1+2+16);
 $sock->disconnect();
    }

    $res = unpack($srvInfo, $result);

    $h = intval($res['gtimescale']);
    $s = ($res['gtimescale'] - $h) * 60*60;
    $m = intval($s / 60);
    $s = $s - $m * 60;

    $file = fopen($host['StatFile'], "w");
    fputs($file, date("m/d/y H:i:s")." spool open.\n");
    fputs($file, "==============================\n");
    fputs($file, "Generation: ".sprintf("%08X", $res['generation'])."\n");
    fputs($file, "Game name: ".stripZ($res['name'])."\n");
    fputs($file, "Type: ".$galTypes[$res['gtype']]."\n");
    fputs($file, "Galaxy size: ".$res['gsize'].'x'.$res['gsize']."\n");
    fputs($file, "Planets: ".$res['planets']."\n");
    fputs($file, "Scale of model step: 1 model Hour(s)\n");
    fputs($file, sprintf("Real time in model year: %02d:%02d:%02d\n", $h, $m, $s));
    fputs($file, "The current modelling date: ".stripZ($res['date'])."\n");
    fputs($file, "Max players: ".$res['maxp']."\n");
    fputs($file, "Registered players: ".$res['regp']."\n");
    fputs($file, "Active players: ".$res['online']."\n");
    fputs($file, "==============================\n");
    fputs($file, "MEMO:\n");
    fputs($file, stripZ($res['notes'])."\n");
    fputs($file, "Game status: Active\n");
    fputs($file, "Server address: ".$host['Host']."\n");
    fputs($file, $host['Port']."\n");
    fputs($file, "Global server address: ".$host['Host']."\n");
    fputs($file, $host['Port']."\n");
    fputs($file, date("m/d/y H:i:s")." spool close.\n");
    fclose($file);

    mailStatus($host, false);
}

set_time_limit(0);
ob_implicit_flush();
for ($i = 0; $i < count($servers); $i++)
{
    echo 'Checking ', $servers[$i]['Host'], ':', $servers[$i]['Port'], ' into ', $servers[$i]['StatFile'];
    checkServer($servers[$i]);
}
?>
WildCat
В свете темы о новом сервере думаю, что неплохо было бы собрать информацию, полезную для держателей серверов, в одном месте, дабы максимально облегчить им нелегкую их жизнь. smile.gif Подумаю над этим. Вот, правда, некоторые вещи может учесть только опытный админ сервака, прошедший боевое крещение... будут мысли, которыми не жалко поделиться, - кидайте! И вам зачтется.
Vladdu
2Корсар:

А нет ли скриптов - аналогов других полезных команд: players score, players list
и т.д. ???
Очень облегчило бы жизнь.
Можно не готовый скрипт smile.gif

А лучше - вообще способ вызова всяких консольных команд,
вплоть до "SEND "$CLP$" TO @ALL"

PS: хотя бы для сервер-owner-ов можно это рассекретить ?
Vladdu
2WildCat:
Я уже когда-то писал H.M.-у, повторюсь.

Главное, чтобы управление сервером было _удаленным_.
Что-то типа:
server_manager -h <srv_host> -p <pswd> <filename>
где
srv_host - адрес, где запущен сервер
pswd - пароль, понятно
filename - имя файла, в котором перечислены команды для сервера (возможно скрипт)
список этих команд могу представить только для текущего Реала:
выбор партии(ведь бывает более одной на сервере), запуск/останов партии, сбор различной статистики.
вообщем, все что делается щас через консоль(sic!) сервера,
включая создание партий.

вывод результатов запросов к серверу (напр.статистики или тек.состояния сервера)
делать в stdout - проще всего, а мы уж как-нибудь разпарсим awk/grep/perl и т.д.
либо предусмотреть указывать имя файла для каждой команды, которая подразумевает вывод:
players score -f pscore.txt

убрать AUTOACTION - это не его задача. есть куча внешних планировщиков (cron, at и т.д.) которые делают это лучше и легче синхронизировать разные задачи (backup-всего сервера ??)
Возможно нужен встроенный планировщик, который работает в игровом времени.
Т.е. чтобы задавать действия на определенные игровые даты.

И последнее:
Сервер должен быть демоном (сервисом), без гуевой(консольной) морды,
писать в логи о своей жизни, причем с разными уровнями детальности, запускать и останавливаться командами real_server start и real_server stop...
Вообщем все уже придумано, давно.
Warrior of Justice
2Vladdu:
Ну, все что ты написал в той или иной мере в сервере уже есть. Демоничность легко эмулируется тем же screenом (заодно получаем такое полезное св-во как удаленное управление: конектимся шелом и вперед). В теории (если бы это было нужно), можно написать скрипт, который будет конектиться к нужной машине по ссх, открывать сессию скрина и впихивать туда интересные команды. Перед выполнением каждой команды можно перенаправить лог куда угодно - вот тебе и вывод результата в файл.

Оно и понятно что удобнее когда все готовое есть и поддерживается напрямую сервером... но как я понял ХМа - влом ему так серьезно эту версию ковырять smile.gif А вот во второй версии было бы здорово все эти плюшки поиметь.
Vladdu
1)
Дык я так и пользую, через одно место ака screen sad.gif
И я понимаю, что тек. сервер менять не будут. Копий много сломано.

WildCat просила предложения для нового сервера. Я их высказал напримере Real4x.

2)
Письмом раньше (которое я написал не видя вопроса WildCat)
я спросил, есть ли в _данной_ версии сервера возможность:
при помощи внешнего запроса (perl/php и т.д.) получать информацию,
как если бы запускать соотв-щие команды в консоли сервера.
Один такой вариант здесь опубликован - аналог game_info - состояние партии
А другие (players list, players score) чем хуже ?
Оскриптовать через screen/ssh/и т.д. не предлагать. Хочется прямее способ.

Добавалять Н.М.-у эту фичу я не предлагаю, нет так нет. Но если есть ? Жалко чтоль ?
Warrior of Justice
Если есть, я бы тоже с удовольствием послушал.
Vladdu
Кому интересно, как с помощью screen выполнить консольные команды сервера...

если реал-сервер запущен так:
1) screen -dmS game1 -s /bin/sh /path/to/real-server.sh

то можно выполнить команды консоли автоматически не заходя на сервер (screen -r game1)

2) screen -r game1 -X exec \!\!\! /path/to/echo_pscore.sh
screen подключится к текущему (-r game1), выполнит на нем команду (-X)
которая запусит шелл (exec), в котором выполнится скрипт (echo_spcore.sh),
который плюнет в stdout строку "@pscore" и перевод строки (пустой echo),
причем опция \!\!\! замкнет взаимно stdin-ы и stdout-ы (и stderr-ы)
работающего сервера и запущеного скрипта echo_pscore.sh,
в результате сервер получит в stdin, то что мы написали в echo

3) в echo_pscore.sh:
===
echo "@pscore"
echo
====

причем 2) можно оформить ввиде скрипта, вызываемого по скрону и обрабатывающего pscore.txt
остальное аналогично.

PS: в боевом варианте еще не проверял, но тесты успешные.
Vladdu
Наткнулся на проблему и сходу не победил sad.gif
что бы команды из п. 2) выполняли вверенную им работу
надо хотя бы раз подключится к screen-у в ручную (screen -r game1)
иначе - как будто игнорируется
остальное пока не подводило...
alkar
прямой способ есть?

через screen (под люнуксом) сервер зависает
Alex
Если был, стали бы мы разводить этот огород.
Второй вариант через упомянутый скрипт автозапуска.
Это "lo-fi" версия форума. Для просмотра полной версии для получения большей информации, форматирования и просмотра изображений, пожалуйста нажмите сюда.
Русская версия Invision Power Board © 2001-2024 Invision Power Services, Inc.