Просмотр сообщений

В этом разделе можно просмотреть все сообщения, сделанные этим пользователем.

Темы - Skif

Страницы: [1] 2 3 4

Perl / Кусок кода скрывается за JS

« : 01 Июля 2011, 16:38:00 »

Собственно сабж. Имеется страничка, на которой интересующая форма скрыта JS. Если выкачать(LWP) или посмотреть исходный текст в браузере, то там присутствует нечто:

<P><strong><script src="http://my.domaine.com/form.php" type="text/javascript"></script> <script type="text/javascript">

на месте, где должен быть HTML-код формы.
Вопрос, как получить в perl такой HTML-код, который генерирует JavaScript в браузере?

JavaScript & JScript / JavaScript + SELECT + selectedIndex

« : 13 Мая 2010, 13:12:18 »

Пишу сейчас простенький калькулятор. Задача следующая есть несколько текстовых инпутов, есть несколько select-ов из оных считать информацию провести необходимые арифметические операции и выдать результат. Собствено HTML код:

<form id="form2" action="#">
<div>srv: <input type="text" id="srv" value="0" /></div>
<div>pc: <input type="text" id="pc" value="0" /></div>
<div>
plan:
<select name="plan" id="plan">

<option value="4">4</option>
</select>
</div>

<input type="button" value="Сумма" onclick="myfunc2()" />

<div>Общая сумма: <input type="text" id="summary" value="0" /></div>в

Всё это должен считать js-скрипт, но к сожалению затык происходит на этапе получения selectedIndex у Select. Вот урезанный код, без арифметики:
var server = new Array(350,270,200);
var pc = new Array(120, 100, 80, 50);
var vzv = new Array (200,180,200);

function myfunc2() {
var srv = document.getElementById(\'srv\');
var pcs = document.getElementById(\'pc\');
var plan = document.getElementsByName(\'plan\');
var tek = document.getElementsByName(\'tek\');
var extr = document.getElementsByName(\'extr\');
var summary = document.getElementById(\'summary\');
var sumsrv = 0;
var sumpc = 0;
var sumplan =0;
var sumtek =0;
var sumextr =0;
var summ = 0;

alert(plan.selectedIndex);
}

Мне постоянно выдается на selectedIndex undefined значение. что делать? Может я неправильно пользую функцию? Как правильно?

Perl / Сервер-Клиент на Perl(IO::Socket) - неполучается

« : 11 Февраля 2007, 13:10:26 »

Сабж.
необходимо для проэкта написать своего демона, который бы слушал порт, принимал сообщения, работая по определенному алгоритму,но получаю маленький затык, на этапе простой отправки приема данных:

#!/usr/bin/perl -w
use IO::Socket;
#use strict;
use POSIX;
require \'sys/syscall.ph\';
my $sock = IO::Socket::INET->new(LocalAddr => \'127.0.0.1\',
                                LocalPort => \'2727\',
                                Listen => 15,
                                Type => SOCK_STREAM,
                                Proto    => \'tcp\');

fork() && exit;

close STDOUT; close STDERR; close STDIN;
chdir \'/tmp\';
syscall(&SYS_setsid);
$SIG{\'INT\'} = $SIG{\'QUIT\'} = $SIG{\'TERM\'} = \'quit\';
$SIG{\'HUP\'} = \'ignore\';

$SIG{CHLD} =\\&REAPER;

while (1){
        while(my $client = $sock->accept()){
                                print $sock "My Net Daemon! Hello!\\n";
                                my $ddd = <$sock>;
                                print $sock $ddd;
                                #`echo $ddd>>/tmp/sk.s `;

        }
}
#sleep 20;
#exit(0);
close($sock);

########### SUBs

sub REAPER {
1 until (-1 == waitpid(-1,WNOHANG));
$SIG{CHLD} =\\&REAPER;
}

Скрипт в демона превращается без проблем. На данном этапе fork для каждого нового подключения мне не нужен, потому его убрал. Суть не в этом.
Согласно кода, у меня в случае подключения к порту 2727 должно в окно терминала выкинуть "My Net Daemon! Hello!\\n". проверяю обычным telnet-ом:

[root@fbsd2.home] /usr/local/script/Dpm/tmp :./s_s_server.pl
[root@fbsd2.home] /usr/local/script/Dpm/tmp :telnet localhost 2727
Trying 127.0.0.1...
Connected to localhost.
Escape character is \'^]\'.
Killed
[root@fbsd2.home] /usr/local/script/Dpm/tmp :

Может кто подсказать, как правильно слать данные и принимать? У меня через дискрипторы не получается, send/recv тоже не идут, правда я мог с флагами напутать. Пока роюсь в этом направлении

Perl / Немного ОТ. PlPerl

« : 11 Января 2007, 23:34:04 »

my ($emp) = @_;

my $res;

if ($emp->{basesalary} != 9) {

undef $res ;

}

else {

$res = "$emp->{name} - $emp->{basesalary} - $emp->{bonus}";

}

return $res;
$$ LANGUAGE plperl;

и вывод:

skif=> select test_sk0(employee.*) from employee;
   test_sk0
---------------
first - 9 - 3

(3 rows)

Но это не то. В общем после всех мытарств у меня получаются выводы либо одной строкой, либо:

skif=> select test_sk0(employee.*) from employee;
     test_sk0
------------------
ARRAY(0x84f677c)
(1 row)

Я конечно могу оформить вызов функции в виде

skif=> select name,test_sk0(employee.*),bonus from employee;
name  | basesalary | bonus
-------+------------+-------
first |          9 |     3
(1 row)

но тогда во многом смысл этой функции теряется.
Пните меня, что я непонимаю или понимаю неправильно.

Perl / Session и массив данных

« : 04 Сентября 2006, 18:14:16 »

Трямки !
Необходимо загнать в файл сессии массив данных. Знаю что способ есть, раньше сам не один раз пользовался, но сейчас припомнить немогу.
Подскажите как загнать?
Пользую CGI::Session

Perl / Proc::ProcessTable выпадают процессы, хотя в top/ps они присутствуют

« : 27 Марта 2006, 15:43:19 »

Собсно сабж. Как с этим бороться? Чаще всего такое происходит ночью, когда на серваке smb шары ставятся на проверку антивирусником. А по крону каждые 5 минут отрабатываются критичные процессы.
"Вылетают" четыре процесса. И если пару я могу отключить от мониторинга, то остальная пара взаимосвязана. Согласно модуля, "вылетают":

natd
pop3d
asterisk
mpg123

ВОт собственно код:

Цитировать

#!/usr/bin/perl -w
use strict;
use warnings;
use lib "/usr/local/scripts/lib/";
use lib "/usr/local/script/lib/";
use skmainmod;
use Sys::Hostname;
use Proc::ProcessTable;

my @etc = (\'/etc/FS/\',\'/usr/local/etc/chk/\',
\'/usr/chk/etc/\',\'/usr/chk/etc/\',
\'/usr/local/chk/etc/\',
\'/usr/script/chk/etc/\',
\'/usr/scripts/chk/etc/\',
\'/usr/local/script/chk/etc/\',
\'/usr/local/scripts/chk/etc/\');

my $etc_file = \'cryt_proc.conf\';

my @log = (\'/usr/local/script/chk/log/\',
\'/usr/local/scripts/chk/log/\',
\'/usr/script/chk/log/\',
\'/usr/scripts/chk/log/\',
\'/usr/local/var/log/chk/\',
\'/usr/var/log/chk/\',
\'/var/log/chk/\',
\'/var/log/\');

my %argv = skmainmod->argum_read(@ARGV);
my $conf_file = $argv{\'conf\'} || skmainmod->chk_file($etc_file,@etc) || die "No found config file!\\nExit!\\n";

my %conf = skmainmod->read_config($conf_file);

my $table = new Proc::ProcessTable;
my @proc_arr = ();
foreach my $process (@{$table->table}) {
   my $res = 0;
   #print "--------------------------------\\n";
   #print $process->fname, "\\n";
   foreach my $tbl (@proc_arr){
      if ($tbl eq $process->fname) {
         $res++;
      }
   }
   if ($res <1) {
      push @proc_arr, $process->fname;
   }

}

my @sort_arr = sort @proc_arr;
@proc_arr = ();
@proc_arr = @sort_arr;
@sort_arr = ();

my $cryt_proc = $conf{\'crytical_process\'};
$cryt_proc =~ s/[\\s\\t++]//g;
my @report_mail;
my $mail_send = 0;
foreach my $chk (sort(split(/\\,/,$cryt_proc))){
   my $res =0;
   my $report = "Crytical process: $chk --->";
   foreach my $pr (@proc_arr){
   #   print "$pr\\n";
      if ($pr eq $chk) {
         $res++;
      }
   }
   if ($res < 1) {
      $report = "$report is down. Warning!!!\\n";
      $mail_send++;
      &send_report(\'sms\',$chk,\'down\');
   }
   else {
      $report = "$report is active.\\n";
   }
   push @report_mail,$report;

}

if ($mail_send > 0){
   &send_report(\'mail\',@report_mail);
}

exit(0);

Соотвественно на выходе в почту и на sms получаю:

Цитировать

DATE of REPORT: 05:00:06 27.03.2006
HOST: k.com.ua
Crytical process: asterisk ---> is down. Warning!!!
Crytical process: httpd ---> is active.
Crytical process: master ---> is active.
Crytical process: mpg123 ---> is down. Warning!!!
Crytical process: mysqld ---> is active.
Crytical process: pptpd ---> is active.
Crytical process: radiusd ---> is active.
Crytical process: smbd ---> is active.
Crytical process: squid ---> is active.
Crytical process: sshd ---> is active.
Crytical process: vtund ---> is active.

В общем проверка показывает, что процесс живой и никуда не девался, а скрипт рапортует, что уходит в даун. Тоесть, есть подозрения, что виной имено модуль Proc::ProcessTable... В чем может быть проблема? Никто не сталкивался с подобным?

Perl / Глупый вопрос по условиям(if...case?).

« : 24 Марта 2006, 00:59:04 »

Предположим есть массив с некоторыми условиями (строками), который имеет свойство меняться. Мне необходимо выполнять проверку на наличие таких слов в строке (в частности в начале). Типичный пример, тот же /etc/fstab или /etc/mtab Где присутствует список вида

Цитировать

# Device Mountpoint FStype Options Dump Pass#
/dev/ad0s1b none swap sw 0 0
/dev/ad0s2b none swap sw 0 0

Мне необходимо убирать строки из , ну например вывода а STDOUT.
тобишь, пусть имеем массив с такими строковыми переменными, строки из файла содержащих их нельзя выводить.

@arr = (\'\\n\',\'#\',\'/dev/hda1\',\'pupkin\',\'estche_chto_to\',\'Nu_i_tut_chego_to\');

Теперь делаю вывод из файла:

Цитировать

my @arr = (\'\\n\',\'#\',\'/dev/hda1\',\'pupkin\',\'estche_chto_to\',\'Nu_i_tut_chego_to\');

open (F, /path_to_file) || die "Can not open file!\\exit!\\n" ;
while (){
if (($_ !~ m/^$arr[0]/g) && ($_ !~ m/^$arr[1]/g) && ($_ !~ m/^$arr[2]/g) && ($_ !~ m/^$arr[3]/g) && ($_ !~ m/^$arr[4]/g) && ($_ !~ m/^$arr[5]/g)) {
print $_;
}
}
close (F);

Но как видно из кода мне смысла никакого от этого массива - так как пересиления условий приходиться делать руками, а у меня они время от времени меняются. Не хочется каждый раз править код, да и не только я буду им пользоваться, в конце концов. Можно ли как-то красиво заменить кучу if ((...)&&(...)) на что-то более гибкое ? Массив всн жн меняется (список читается банально из файла). Чувствую выход в регулярном выражении, но оно у меня не складывается... Ну ни как....

Perl / FS + perl + Sys-Filesystem - работает под фрей?

« : 23 Марта 2006, 16:14:41 »

Трямки всем.
Собственно сабж. _Необходим для скриптов по состоянию FS модуль. Нашел что подойдет для перла Sys::Filesystem на search.cpan.org. но воспользоваться не получается

Цитировать

perl Makefile.PL
make

проходит без проблем, при выполнении make test :

Цитировать

[root@k.com.ua] /usr/local/script/FS/Sys-Filesystem-1.18/:make test
PERL_DL_NONLAZY=1 /usr/local/bin/perl "-MExtUtils::Command::MM" "-e"
"test_harness(0, \'blib/lib\', \'blib/arch\')" t/*.t
t/01test....Use of uninitialized value in hash element at ../lib/Sys/Filesystem/Freebsd.pm line 44, line 17.
.......................................................................
Use of uninitialized value in hash element at ../lib/Sys/Filesystem/Freebsd.pm line 49, line 17.
Use of uninitialized value in hash element at ../lib/Sys/Filesystem/Freebsd.pm line 49, line 17.
Unable to open mtab file (/etc/mtab)
_at (eval 9) line 1
_at lib/Sys/Filesystem.pm line 77
_ _ _ _ Sys::Filesystem::new(\'Sys::Filesystem\') called at lib/Sys/Filesystem.pm line 120
_ _ _ _ Sys::Filesystem::filesystems(\'device\', \'/dev/ad0s1a\') called at t/01test.t line 30
# Looks like you failed 1 tests of 62.
t/01test....dubious
_ _ _ _ Test returned status 1 (wstat 256, 0x100)
DIED. FAILED test 2
_ _ _ _ Failed 1/62 tests, 98.39% okay
Failed Test Stat Wstat Total Fail _Failed _List of Failed
-------------------------------------------------------------------------------
t/01test.t _ _ 1 _ 256 _ _62 _ _1 _ 1.61% _2
Failed 1/1 test scripts, 0.00% okay. 1/62 subtests failed, 98.39% okay.
*** Error code 2

Stop in /usr/local/script/FS/Sys-Filesystem-1.18.

Валиться короче. Ок. Ставлю linux_base, делаю mtab из fstab, повторяю make test, предварительно убедившись, что linux.ko загружен:

Цитировать

[root@k.com.ua] /usr/local/script/FS/Sys-Filesystem-1.18/:kldstat -v | grep
linux
_4 _ _1 0xc2845000 17000 _ _linux.ko
_ _ _ _ _ _ _ _ 165 linuxelf
_ _ _ _ _ _ _ _ 166 linuxaout

Цитировать

[root@k.com.ua] /usr/local/script/FS/Sys-Filesystem-1.18/:make test
PERL_DL_NONLAZY=1 /usr/local/bin/perl "-MExtUtils::Command::MM" "-e"
"test_harness(0, \'blib/lib\', \'blib/arch\')" t/*.t
t/01test....Use of uninitialized value in hash element at ../lib/Sys/Filesystem/Freebsd.pm line 44, line 17.
Use of uninitialized value in hash element at ../lib/Sys/Filesystem/Freebsd.pm line 45, line 17.
.......................................................................
Use of uninitialized value in hash element at ../lib/Sys/Filesystem/Freebsd.pm line 49, line 17.
Use of uninitialized value in hash element at ../lib/Sys/Filesystem/Freebsd.pm line 49, line 17.
Unable to open mtab file (/etc/mtab)
_at (eval 9) line 1
_at lib/Sys/Filesystem.pm line 77
_ _ _ _ Sys::Filesystem::new(\'Sys::Filesystem\') called at lib/Sys/Filesystem.pm line 120
_ _ _ _ Sys::Filesystem::filesystems(\'device\', \'/dev/ad0s1a\') called at t/01test.t line 30
# Looks like you failed 1 tests of 62.
t/01test....dubious
_ _ _ _ Test returned status 1 (wstat 256, 0x100)
DIED. FAILED test 2
_ _ _ _ Failed 1/62 tests, 98.39% okay
Failed Test Stat Wstat Total Fail _Failed _List of Failed
-------------------------------------------------------------------------------
t/01test.t _ _ 1 _ 256 _ _62 _ _1 _ 1.61% _2
Failed 1/1 test scripts, 0.00% okay. 1/62 subtests failed, 98.39% okay.
*** Error code 2

Stop in /usr/local/script/FS/Sys-Filesystem-1.18.

Если просто сделать make install то модуль ставиться, только мне с этого не холодно и не жарко - он не работает - вываливается с ошибками

Кто ставил этот модуль, или может посоветовать альтернативный для perl? Оч надо.
варианты типа

Цитировать

system "df";
system "du";

или

Цитировать

$p=`df`;
$p=`du`;

не предлагать - не подходят по идиологическим мотивам.

Всё о Html / Немного css

« : 22 Марта 2006, 16:28:10 »

не могу понять, почему не применяется такое вот:
#dftable {

cellspacing: 0;

cellpadding: 0;

border: 0;

align: center;

width: 100%;

height: 100%;

bgcolor: 000000;

leftMargin: 0;
}
В HTML:
<table id=\'dftable\'>

Таблица на весь экран не разворачивается и черным цветом не заливается, но если сделать:

<table cellspacing=0 cellpadding=0 border=0 align=center width=100% height=100% bgcolor=000000 leftMargin=0>

То все чудесно... ?

Perl / Net::Ping и FreeBSD

« : 03 Декабря 2005, 22:31:54 »

Собсно сабж.
Заметил что под фрей этим пакетом можно слать только дефолтные пакеты длиной 56 байт:

Цитировать

21:25:57.131716 k.com.ua > a.kiev.ua: icmp: echo reply (ttl 64, id 54617, len 84)
21:25:57.162349 a.kiev.ua > k.com.ua: icmp: echo request (ttl 58, id 59159, len 84)
21:25:57.162438 k.com.ua > a.kiev.ua: icmp: echo reply (ttl 64, id 54619, len 84)
21:25:57.192573 a.kiev.ua > k.com.ua: icmp: echo request (ttl 58, id 7201, len 84)
21:25:57.192652 k.com.ua > a.kiev.ua: icmp: echo reply (ttl 64, id 54620, len 84)
21:25:57.222841 a.kiev.ua > k.com.ua: icmp: echo request (ttl 58, id 48393, len 84)

Вот как пускаю ping:

Цитировать

#!/usr/bin/perl -w
use Net::Ping::External qw(ping);

# Ping a single host
my $send =1000;
my $recive =0;
my $loss=0;
for(my $i=0;$i<$send;$i++){
my $alive = ping(host => "some_ip_address",size=>1500);
# print "127.0.0.1 is online" if $alive;
# print "$alive\\n";
if ($alive){
$recive++;
}
}
$loss = $send-$recive;
print "Send - $send, Recive - $recive, Loss - $loss\\n";
exit(0);

В принципе в доке к нему написано, что его не тестили под фрей, но под OpenBSD вроде как работает... Может все же у меня руки кривые?
P.S.: Все сие актуально как под root так и под непривелигированным пользователем

Perl / Таблицы, глюки с высотой

« : 04 Октября 2005, 12:34:22 »

Имеется такой вот код:

Цитировать

#!/usr/bin/perl -w

use lib "/usr/local/scripts/lib/";
use lib "/usr/local/script/lib/";
use CGI;
use CGI::Session;
use HTTP::BrowserDetect;
use Time::localtime;
#use sk_mod;

my $brouser = new HTTP::BrowserDetect($ENV{\'HTTP_USER_AGENT\'});

my $cgi = new CGI;

print $cgi->header(-expires=>\'no cache\', -charset=>\'koi8-r\');
if ($brouser->browser_string() ne \'MSIE\') {
   print \'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">\';
}

my $headpage="Skif home page";
print $cgi->start_html(-title=>$headpage, -bgcolor=>\'ffffff\',-leftmargin=>\'0\', -topmargin=>\'0\', -marginwidth=>\'0\', -marginheight=>\'0\',text=>\'lightgrey\');

print "";
print "";
print "
";
   #header_table(\' K L O \',\'eng\');
   print "asdasda";
print "
";
   #midle_table();
   print "asdasda2";
print "
";
   #low_table();
   print "asdasda3";
print "
";

print $cgi->end_html;

И имеется глюк - таблица выстраивается не на полную высоту экрана, а только на ту часть, что занята текстом, а надо бы на полную, что я делаю не так? (Зы если в HTML писать туже страницу - все получается как положено).
Кто-то может подсказать в чем может быть ошибка?
Браузер задетектил и нужный текст впихнул, но даже под IE (хотя все привык делать под konqueror) не растягивается.

Perl / Глюки Mail::Sender

« : 23 Сентября 2005, 12:13:27 »

Есть код работающий по разному на разных машинах. Почему - понять не могу:

Цитировать

sub send_mail {
shift @_;
my $result = 0;

my $smtpserver = shift @_;
my $smtpport = shift @_;
my $from = shift @_;
my $to = shift @_;
my $subj = shift @_;
my $message = shift @_;
my $attache = shift @_;
my $logfile = shift @_;
#;read_conf($conf,\'logfile\') || \'/var/log/urbd.log\' ;

print "Sending mail:\\n";
print "SMTP - $smtpserver\\n";
print "SMTP PORT - $smtpport\\n";
print "FROM: $from\\n";
print "TO: $to\\n";
print "Subject: $subj\\n";
print "Attached file: $attache\\n\\n";
print "\\n========------------- SMTP HEADER ---------------========\\n";

&logfile(\'sk_mod\',$logfile,"Sending mail...$subj");

$message = "$message \\n\\n";

open (MES, $logfile);
while () {
   $message = "$message$_";
}
close(MES);

my $sender = new Mail::Sender {smtp => $smtpserver, from => $from};
$sender->MailFile({to => $to,
   subject => $subj,
   msg => $message,
   file => $attache}) or $result = 1;

$sender->Close;# || &logfile($logfile,"Failed sand message $sender->{\'error_msg\'}"); # or $result = 2;

print "\\nresult of sending mail ... :$result\\n";

if ($result == 0) {
   &logfile(\'sk_mod\',$logfile,"Mail sended");
}

if ($result == 2) {
   &logfile(\'sk_mod\',$logfile,"Failed sand message $sender->{\'error_msg\'}");
}
sleep 5;

return $result;
}

Mail::Sender стоит на всех тазиках. Ругается на строку

Цитировать

123
[root@k] /usr/ports/mail/p5-Mail-Sender/:/usr/local/script/urbd/bin/urbdmailclean.pl -conf=/usr/local/script/urbd/etc/sk_mailclean.conf
Ok!
Trying send mail....
Sending mail:
SMTP - 127.0.0.l
SMTP PORT - 25
FROM: mailclean.urbd
TO: mailclean.report@klo.kiev.ua
Subject: CLEAN MAIL REPORT
Attached file: /usr/local/script/urbd/log/mailclean.log

========------------- SMTP HEADER ---------------========
Can\'t call method "MailFile" without a package or object reference at /usr/local/script/urbd/lib/sk_mod.pm line 86.
[root@k] /usr/ports/mail/p5-Mail-Sender/:

На другой машине все проходит на ура с сим скриптом и пакектом.
В чем могут быть грабли?

Perl / Помогите найти ошибку... устал...

« : 07 Сентября 2005, 11:01:46 »

Устал искать уже который день ошибку.
Вот код на чтение конфига:

Цитировать

# ============================================================
#       SUBS
# ============================================================
sub read_conf {

my $conf = shift @_;
my $var = shift @_;
if ($var =~\'pathtosave_folder\') {
   print "PATH TO SAVE !!!!";
}
my $result;
my $logfile = \'E:\\logfile.log\';
open (CONF, "<$conf") || &logfile($logfile, "Can not open config file ( $conf ). File unaviable or you haven\'t permissions!\\n");
my $line;
while ($line = ) {
   if (($line!~ m/^[\\s\\t++]\\#/g) and ($line!~ m/^#/g) and ($line!~ m/^[\\s\\t++]\\n/g) and ($line!~ m/^[\\s\\t++]#/g) and ($line!~ m/^\\n/g)) {
      $line =~ s/[\\s\\t++]//g;
      chomp $line;
      ($param,$arg) = split (/=/,$line);
      $result = $arg if $param eq $var;
   }
}
close (CONF);
return $result;
}

Вот содержимое самого конфига:

Цитировать

####################################################
#
# Общие конфигурационные настройки для соединения и т.д.
#
####################################################
#
# CONFIG FONDU
#
# адресс SMTP сервера
smtpserver = 10.0.43.1
# порт SMTP сервера
smtpport = 25
# адрес POP3 сервера
pop3server = 10.0.43.1
# порт POP3 сервера
pop3port = 110
# имя пользователя для забора почты с POP3 сервера
pop3user = urbd.fishka
# пароль пользователя для забора почты с POP3 сервера
pop3pass = olk
# забор писем только от пользователя где в поле FROM стоит
# указааный адрес и отправка ответных писем только на этот адрес
# Внимание! Обратите внимание на соответствие адресов откуда
# получается и куда отправляется почта с их заговками (тема письма)
# наче могут быть конфликты при обмене!
from = urbd.fondu@xxx.com
# отправлять почту с обменом c адреса на адрес
mailfrom = urbd.fishka@xxx2.com
# ошибки и отчеты отправлять на адрес
mailtoreport = skif@xxx.ua
# Подстрока, которая должна присутствовать в поле Subject письма,
# забираемого с POP3 сервера
subject = URBD-FONDU
# Папка куда будут сохраняться получаемые вложения (с указанием имени файла)
pathtosave_folder = D:\\1c_dbs\\Buch\\1sbukr\\pc\\
pathtosave_files = FONF.zip
# Папка откуда будут браться отправляемые вложения (в имени файла не должно
# быть запятых!!!)
pathtosend_folder = D:\\1c_dbs\\Buch\\1sbukr\\cp\\
pathtosend_files = FONE.zip
#################################################
# Настройки непосредственно для 1С
# ================= for 1C ====================
#
# Путь к исполняемому файлу 1С
pathto1c = C:\\Progra~1\\1Cv77adm\\bin\\1cv7sa.exe
# Имя базы 1С
name1cbase = FONDU-FISHKA
# Расположение базы 1С (путь)
path1cbase = D:\\1c_dbs\\Buch\\1sbukr
# Путь к временной папке
pathtotmp = E:\\scripts\\1c_exch\\TMP
# расположение PRM файла для пакетного режима 1С
prmfile = E:\\scripts\\1c_exch\\tmp\\fishka_fondu.prm
# Расположение файла отчета о работе пакетного режима
logfile = E:\\scripts\\1c_exch\\log\\fishka_fondu.log
# Имя пользователя на базу 1С
user1c = URBD
# пароль пользователя на базу 1С
pass1c = urbd

А вот что дает вывод с чтения всех переменных(у меня ложиться в лог и шлеться по почте отчет):

Цитировать

Result of autoexchange in the attache. Date Wed Sep _7 09:31:34 2005

Wed Sep _7 09:31:24 2005 Variable for URBD script:

________________CONFIG : e:\\scripts\\1c_exch\\etc\\urbd.conf.fondu
________________POP3 state : 1
________________SMTP state: 1

________________POP3 Server : 10.0.43.1
________________SMTP Server : 10.0.43.1
________________POP3 PORT : 110
________________SMTP port : 25
________________POP3 User urbd.fishka
________________POP3 Password olk
________________POP3 Authentificate mode : _PASS
________________MAIL recive From : urbd.fondu@xxx.com
________________Mail From : urbd.fishka@xxx2.com
________________MAIL to report : skif@xxx.ua
________________MAIL Subject : URBD-FONDU
________________Path to save (folder) : /tmp
________________Parg to send(folder): /var
________________FILES to send : tmp.zip
________________FILES to save : tmp.zip
________________PATH to 1C : C:\\Progra~1\\1Cv77adm\\bin\\1cv7sa.exe
________________Name 1C base : !Autoprofit
________________Path to 1C base : D:\\1c_dbs\\Buch\\1sbukr
________________Path to TEMP folder: E:\\scripts\\1c_exch\\TMP
________________Path to PRM file : E:\\scripts\\1c_exch\\tmp\\fishka_fondu.prm
________________Path to logfile : E:\\scripts\\1c_exch\\log\\fishka_fondu.log
________________USER 1C : URBD
________________Password to 1C : urbd
________________Path to logfile 1C : E:\\scripts\\1c_exch\\log\\fishka_fondu.log.exch.log

Wed Sep _7 09:31:24 2005 All main variables checked!

Самые интересные параметры: pathtosend_folder, pathtosave_folder есть еще парочка, но понять хотя бы их.
Как видно из конфига они имеет следующий вид(чтение в коде)

my $pathtosave = &read_conf($conf,\'pathtosave_folder\') || \'/tmp\';
$conf_var = "$conf_var\\t\\tPath to save (folder) : $pathtosave\\n";

my $pathtosend = &read_conf($conf,\'pathtosend_folder\') ||\'/var\';
$conf_var = "$conf_var\\t\\tParg to send(folder): $pathtosend\\n";

В теории они должны были бы принять значения
D:\\1c_dbs\\Buch\\1sbukr\\pc\\
D:\\1c_dbs\\Buch\\1sbukr\\cp\\
Как прописано в конфиге:

pathtosave_folder = D:\\1c_dbs\\Buch\\1sbukr\\pc\\
pathtosend_folder = D:\\1c_dbs\\Buch\\1sbukr\\cp\\

Но шиш. Они принимают дефолтные значения, пото му что во всех случаях кроме данного $read_conf возвращает параметр, а в этом нет

Не могу понять почему.
Пните, что упускаю из виду...

Perl / парсим атачи в письме. Или немного о MIME::Base64

« : 21 Июля 2005, 02:13:50 »

Столкнулся с проблемой на ActivePerl в работе одного из модулей в результате чего вынужден самомтоятельно парсить все заголовки и тело письма.
В принципе мне надо выдрать только аттач(аттачи) и все.

сваял несколько вариантов кода, вот два примера:
Первый

if ($size > 1) {

for (my $i = 1 ;$i <($size-1) ;$i++) {

print "============= part $i ==============\\n";

#print "$arr_message[$i]";

if ($arr_message[$i]=~m/filename=/gi) {

print "Exist FILENAME=";

my $line = $arr_message[$i];

my $mail = Email::Simple->new($line);

my $bod = $mail->body;

$bod =~ s/\\n//gi;

open (TMP,">e:\\\\scripts\\\\1c_exch\\\\tmp\\\\file.txt")|| die "Cannot open file!\\n";

print TMP $bod;

close (TMP);

open (OTMP,">e:\\\\scripts\\\\1c_exch\\\\tmp\\\\file.zip")|| die "Cannot open file!\\n";

print OTMP decode_base64($bod);

close (OTMP);

}

print "====================================\\n";

}

}

Второй:

$r ="\\#";

$line =~ s/\\n/$r/g;

$line =~ tr#A-Za-z0-9.\\-\\=\\;\\"\\#\\\\\\/+/##cd;

$line =~ s/$r/\\n/g;

my $file ="filename=\\"";

my $end ="\\"";

my @arr = split(/\\n\\n/,$line);

my $att_head = $arr[0];

my $att_file = $arr[1];

$att_file =~ s/\\n//g;

$att_file =~ tr#A-Za-z0-9+/##cd;

my @arr_file_1 = split(/$file/,$att_head);

my @arr_file_2 = split(/$end/,$arr_file_1[1]);

my $filename = $arr_file_2[0];

print "$filename\\n";

print "=================== BODY of file in BASE64 ========================\\n$att_file\\n";

$file_decode = decode_base64("$att_file=");

open (TMP,">c:\\\\$filename");

print TMP $file_decode;

close(TMP);

Остальные вариации на тему.

В принципе файл сохраняется. Его можно открыть(это архив, но... Имеем проблему ошибки CRC, попытка забора внешним клиентом - все чудно забирается и работает.

Так же обратил внимание на то, что просто при парсинге частей письма (имею ввиду частей отделенных boundary в multipart) В теле таких частей присутствует не обычный символ перевода строки, а несколько покалеченный или пара символов. в hex глянул 0А, тобишь 10. Пришлось извращаться что бы разбить полученное тело части на составляющие и вычленить имя вложения и непосредственно закодированное в Base64 тело файла... Но... Оба варианта хоть и воркают, но дают ошибку CRC, при этом я точно знаю, что в архиве два файла, но вижу только один. Ну это не удивительно, раз архив битый.

Цитировать

Content-type: application/octet-stream; name="AF1.zip"; type=Unknown;charset=win
dows-1251;
Content-description: AF1.zip
Content-transfer-encoding: Base64
Content-disposition: attachment; filename="AF1.zip"

UEsDBBQAAAAIAMIb9DLDN61vnQEAAMYCAAAMAAAAMUN2NzdDaHMuZGF0bVFNS8NAEL0X/A9lz7th
d7NJNp7MxwY8KeqxIDHdlmCahDS1YNv/1rOCXvwBIgj1YBXxrpukalpMspOZeW/eLDN7nVlgc8di
ro98x+aIEeIh7lGBsPBMwxEm1QMBwc3tHYCBSV1hmQGyBA0QM3yMXMPCyLddbjkm4TZxIXACALFg
wuCuQMTCPmKYWYhXoeMEuoeZaqB7EBBi03lF3+vMgBNdptk0kf2hHMm0HDdZRcHzqvliUcdelo7L
sIKb+EQOZCHTSDZ8w8ZWnWdGXQUBniszCuMkm5RbXgVg9ZLaMmpD3Egyc7f0MG0724UEcwJpczvD
1nktQdsKXfVQ9afa/fP76lOdl9fHr+7y6WP99r7+XH20NMGkuOif5+FVeTCcovxKG1yM+8OpFmUj
xVJfllwC1ZlAIPZ7p1ER52XvuMgG8VlPKWgYN/MHSwANYtYlywdliMI0pmsEVASiXcd57eGN18Z/
76CGvtjsJsomf0P3s2jS7KiJz+QoT8JSdo9yWYRlrHb0w5SJLGW/21rTNrAr9ZPf7bhJ/9tp8Q1Q
SwMEFAAAAAgAwhv0MoGVP+eAAAAAlQAAAAsAAAAxQ3Y3N0RsZC5pZBXMMQpCMQyA4V3wDtK5gaYv
bdIxbVLwGIKj+EYHfRdU8Ew+x3/4v+PhGWx93G/r5Xo6W4iziTJ1A9MmQIgDZGSH5KMW9ZqX6THo
DDE5eZHugJwMKBGD/FN1LiPRfi0jhvfnu6M1d+c6gT1PoGIJeuEE1rqwVpSGPQbEll+7vP0AUEsB
AhQAFAAAAAgAwhv0MsM3rW+dAQAAxgIAAAwAAAAAAAAAAgAgALaBAAAAADFDdjc3Q2hzLmRhdFBL
AQIUABQAAAAIAMIb9DKBlT/ngAAAAJUAAAALAAAAAAAAAAIAIAC2gccBAAAxQ3Y3N0RsZC5pZFBL
BQYAAAAAAgACAHMAAABwAgAAAAA=

А так выглядит отпарсенная часть тела письма с аттачем....

Собственно вопрос, как правильно перекодировать, что бы файл нормально открывался?
Или где здесь ошибка?
Может есть еще вараиция на тему?
Email::MIME::Attachment::Stripper Не хочет онработать под виндой, хоть тресни. Устал с ним бороться.

Perl / непонятки с Mail::POP3Client

« : 19 Июля 2005, 17:49:58 »

Имеется кусок кода который по разному работает на разных серверах, например, на связке postfix + cpurier-imap + mysql все ок!, на sendmail +qpopper ошибки:

Цитировать

Jul 19 16:36:28 gw-pv popper[492]: apop "skif@gw-pv.fbsdgw.com"
Jul 19 16:36:28 gw-pv popper[492]: skif@gw-pv.fbsdgw.com@mersedes: -ERR Password supplied for "skif@
gw-pv.fbsdgw.com" is incorrect.
Jul 19 16:37:39 gw-pv popper[498]: apop "skif"
Jul 19 16:37:39 gw-pv popper[498]: skif@mersedes: -ERR POP authorization DB not available (skif)

вот "проблемный" кусок кода:

Цитировать

#!/usr/bin/perl
use Mail::Sender;
use Mail::POP3Client;
use Email::MIME;
use Email::MIME::Attachment::Stripper;

   print "Connecting to pop3-server.........................";
   my $pop = new Mail::POP3Client( USER => \'skif\',PASSWORD => \'password\',HOST => \'10.0.43.1\');

   print "$pop\\n\\nPOP3 ----!!!! ", $pop->Connect(),$pop->Count(), "\\n";
   $pop->Close();

немгу никак въехать почему. Весь остальной софт нормально забирает почту с этого сервера. Этот же скрипт нормально получает информацию о количестве писем и их содержимом на серваке, качает письма на диск, но с другого сервера. Почему?:insane:

Страницы: [1] 2 3 4

Новости: