1. Perl / Говнокод #5764

    −125

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    # Функция проверки валидность и сравнение ip адресов
            # Пользоваться: dynamic_comparison_ip($bc, $s1, $s3, $s5, $s8)
            sub  dynamic_comparison_ip
            {
                  my ( $bc, $s1, $s3, $s5, $s8 ) = @_;
    
                  my $ip_regext = qr/(?:[0-9]\.|[0-9]{2}\.|[0-2][0-9]{2}\.){3}(?:[0-9]|[0-9]{2}|[0-2][0-9]{2})/;
    
                  if ( ( $bc->{config_params}{HOST} eq $s1 ) or
                       ( $bc->{config_params}{HOST} eq $s3 ) or
                       ( $s1 eq $s3 ) or
                      ( ($s5 =~ $ip_regext ) and ( $bc->{config_params}{HOST} eq $s5  or  $s1 eq $s5 or  $s3 eq $s5  ) ) or
                      ( ($s8 =~ $ip_regext ) and ( $bc->{config_params}{HOST} eq $s8  or  $s1 eq $s8 or  $s3 eq $s8  ) ) or
                      ( ($s5 =~ $ip_regext ) and ($s8 =~ $ip_regext ) and ( $s5 eq $s8 ) )
                     ) {
                                       $bc->{const}{warning}->debug("Warning!!!! String $_ not valid!!!");
                                       return 1;
                 } else {
    
                                       return 0;
                 }
            }

    Предыдущие куски были мной отформатированы уже для лучшего понимания. А это - оригинал... Просто шедевр.

    SadKo, 22 Февраля 2011

    Комментарии (7)
  2. Perl / Говнокод #5763

    −123

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    sub initialize  # Действия выполняемые непосредственно перед стартом цикла если мы ведём базу, что бы подгрузится из неё!!!!!
    {
    	my $bc = shift; 
    
    	if ( $bc->{const}{jnl} eq "1" )
    	{
    		$bc->{variable}{ip_addr} = run_shell_script("ip a", 'l');
    
    		open JNL, '<', $bc->{const}{base_jnl};
    		undef $\;
    		my @jnl_strings = <JNL>;
    		close JNL;
    
    		my $ip_regext = qr/(?:[0-9]\.|[0-9]{2}\.|[0-2][0-9]{2}\.){3}(?:[0-9]|[0-9]{2}|[0-2][0-9]{2})/;
    
    		map
    		{
    			chomp;
    
    			if (/^($ip_regext);(.*);($ip_regext);(.*);opt\[ip_v_2:(.*),(.*);int_2:(.*),(.*),(.*)\]$/)
    			{
    				my ( $s1, $s2, $s3, $s4, $s5, $s6, $s7, $s8, $s9 ) = ( "$1", "$2", "$3", "$4", "$5", "$6", "$7", "$8", "$9" );
    
    				if ( dynamic_comparison_ip($bc, $s1, $s3, $s5, $s8) == '1' )
    				{
    					cut_jnl($bc, $s1, '');
    				}
    				else
    				{
    					$bc->{variable}{base_virtual_ip}{$s1} = $s3;
    					$bc->{variable}{base_mask_v_ip}{$s1} = $s2;
    					$bc->{variable}{base_id}{$s1} = $s4;
    					$bc->{variable}{base_addit_v_ip}{$s1} = $s5;
    					$bc->{variable}{base_mask_v_ip_addit}{$s1} = $s6;
    					$bc->{variable}{base_addit_dev}{$s1} = $s7;
    					$bc->{variable}{base_addit_ip}{$s1} = $s8;
    					$bc->{variable}{base_mask_ip_addit}{$s1} = $s9;
    					$bc->{variable}{base_info_T}{$s1} = $bc->{variable}{no_info_T_max};
    					$bc->{variable}{base_delay}{$s1} = 0;
    					$bc->{const}{info}->debug("String $_ has been added in dynamic base");
    
    					push @{$bc->{variable}{base_load_conf}}, $s1; # Формируем базу загруженных из файла
    
    					$bc->{variable}{intrf_eth0} = Modules_SR::Ifconfig_all->new(
    						"$bc->{config_params}{HOST}", 
    						"$bc->{variable}{base_mask_v_ip}{$s1}");
    
    					if ($bc->{variable}{base_addit_v_ip}{$s1})
    					{
    						$bc->{variable}{intrf_eth00} = Modules_SR::Ifconfig_all->new("
    							$bc->{config_params}{HOST}", 
    							"$bc->{variable}{base_mask_v_ip_addit}{$s1}"); 
    					}
    					
    					if ($bc->{variable}{base_addit_dev}{$s1})
    					{
    						$bc->{variable}{intrf_eth1} = Modules_SR::Ifconfig_all->new(
    							"$bc->{variable}{base_addit_dev}{$s1}", 
    							"$bc->{variable}{base_mask_ip_addit}{$s1}");  
    					}
    
    					check_stop_status($bc, "$s1");
    				}
    			}
    			else
    			{
    				$bc->{const}{info}->debug("String $_ hasn't been added in dynamic base");
    				$bc->{const}{warning}->debug("String $_  has incorrect format!!!");
    			}
    		} @jnl_strings;
    	}
    } # end Действия выполняемые непосредственно перед стартом цикла

    Всё оттуда же. Инициализация объекта. Теперь делать через map {} стало, по-видимому, модно. Куча непонятно зачем нужных переменных и полей... FACEPALM...

    SadKo, 22 Февраля 2011

    Комментарии (1)
  3. Perl / Говнокод #5762

    −124

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    if ($bc->{variable}{status} eq "1" && $bc->{variable}{wait} eq "mmua" &&    # Действия при получении подтверждения старта
    			$bc->{const}{data} =~ /^MMUA\(mkd;$bc->{config_params}{VIRTUAL_IP};.*;$bc->{config_params}{HOST};$bc->{config_params}{TCM_ID};.*;.*\)$/)
    	{
    #		$bc->{const}{info}->debug("START ACCEPT");
    		
    		$bc->{const}{console_out} = "1.Answer SR-Slave: ok\n";
    		
    		my $res = check_virtual_ip($bc, "0", "0", "1", "$bc->{config_params}{VIRTUAL_IP}");
    		$bc->{const}{info}->debug("check_virtual_ip = $res");
    
    		unless ($res =~ /.*exist already and not local.*/)
    		{
    			EXECUTE_START($bc);
    			$bc->{const}{info}->debug("Start permit");
    		}
    		else
    		{
    			$bc->{const}{info}->debug("Start not recommend");
    		}
    
    		$bc->{const}{console_out} .= "2.Answer check_virtual_ip: " . $res;
    		open (RESPONSE, ">$bc->{const}{res_start}");
    		print RESPONSE $bc->{const}{console_out};
    		close RESPONSE;
    	}
    	elsif ($bc->{variable}{status} eq "1" && $bc->{variable}{wait} eq "mmua") # Действия при ожидании подтверждения от Сервера старта
    	{
    #		$bc->{const}{info}->debug("START ACCEPT WAIT");
    		
    		if ( $bc->{variable}{var_T1} >=  $bc->{variable}{T1} )
    		{
    			$bc->{const}{console_out} = "1.Answer SR-Slave: slave doesn't answer\n";
    			
    			my $res = check_virtual_ip($bc, "0", "0", "1", "$bc->{config_params}{VIRTUAL_IP}");
    			$bc->{const}{info}->debug("check_virtual_ip = $res");
    
    			unless( $res =~ /.*exist already and not local.*/ )
    			{
    				EXECUTE_START($bc);
    				$bc->{const}{info}->debug("Start permit");
    			}
    			else
    			{
    				$bc->{const}{info}->debug("Start not recommend");
    			}
    
    			$bc->{const}{console_out} .= "2.Answer check_virtual_ip: " . $res;
    
    			open (RESPONSE, ">$bc->{const}{res_start}");
    			print RESPONSE $bc->{const}{console_out};
    			close RESPONSE;
    		}
    		else
    		{
    			++$bc->{variable}{var_T1};
    		}
    ### Возможно жопа здесь !!!!!
    	}
    	elsif (-e $bc->{const}{req_restart} or $bc->{variable}{before_start} eq '1') # Действия при обноружении рестарта ручного или при первом запуске
    	{
    #		$bc->{const}{info}->debug("FIRST START / RESTART");
    		
    		unlink $bc->{const}{req_restart};
    		unlink $bc->{const}{req_restart_program};
    		unless($bc->{variable}{before_start})
    		{
    			$bc->{const}{info}->debug("Found restart.req");
    		}
    		else
    		{
    			$bc->{const}{info}->debug("Starting MASTER -> send MMU...");	      
    		}	      
    
    		send_mmu ($bc, "1", "mmua-for-restart");
    		$bc->{variable}{delay} = $bc->{variable}{delay_max};
    		$bc->{variable}{before_start} = 2 if ($bc->{variable}{before_start} eq '1');   # Не будем отправлять INFO, пока не прийдёт подтверждение MMUA
    	}

    Ещё несколько перлов из утилиты. Так записываем конечный автомат по функционированию протокола. Привёл только маленький кусочек из цепочки IF'ов.

    SadKo, 22 Февраля 2011

    Комментарии (0)
  4. Perl / Говнокод #5754

    −123

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    sub check_interface
    {
    	my $int_input = shift;
    	my $all_intr_local = [];
    	$_ = qx[ip a];
    	s[\d{1,}:[ ]{1,}([^ ]{1,}):.*]<unshift(@$all_intr_local, $1)>ge;
    	if ( ! grep( { /^$config_params{$int_input}$/ } @$all_intr_local ))
    	{
    		$warning->debug("Error: interface $int_input can't found local!!!");
    		exit 1;         
    	}
    	else
    	{
    		$info->debug("Load param $int_input = $config_params{$int_input}.");   
    	}
    }

    А вот так мы сканируем сетевые интерфейсы...

    SadKo, 21 Февраля 2011

    Комментарии (10)
  5. Perl / Говнокод #5753

    −124

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    sub check_dir
    {
    	my ($param, $mode) = @_;
    	$mode ||= 'sr';
    
    	unless ( $mode eq 'sc')
    	{
    		my $full_path = $config_params{$param};
    		$full_path =~ /^(.+)\/(.+)$/;
    		my $put = $1;
    
    		while(1)
    		{
    			if (-l $full_path)
    			{
    				$info->debug("Load param $param = $full_path it is symlink. Readlink...");
    				$full_path = readlink $full_path;
    			}
    			elsif (-d $full_path or -d "$put/$full_path")
    			{
    				$info->debug("Load param $param = $full_path. It is directory and it is exists");
    				last;
    			}
    			else
    			{
    				$warning->debug("Not valid config. Error parsing param: $param");
    				exit 1;
    			}
    		}
    	}
    	else
    	{
    		my $full_path = $config_params_sc{$param};
    		$full_path =~ /^(.+)\/(.+)$/;
    		my $put = $1;
    
    		while(1)
    		{
    			if (-l $full_path)
    			{
    				$info_sc->debug("Load param $param = $full_path it is symlink. Readlink...");
    				$full_path = readlink $full_path;
    			}
    			elsif (-d $full_path or -d "$put/$full_path")
    			{
    				$info_sc->debug("Load param $param = $full_path. It is directory and it is exists");
    				last;
    			}
    			else
    			{
    				$warning_sc->debug("Not valid config. Error parsing param: $param");
    				exit 1;
    			}
    		}
    	}
    }

    По крайней мере, этот код можно сократить вдвое... И подобное по всей утилите...

    SadKo, 21 Февраля 2011

    Комментарии (2)
  6. Perl / Говнокод #5664

    −119

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    sub dopprobelz # функция дополнения строки нулями вначале
            {
                my($str)=@_[0];
                my($len)=@_[1]; my $delta=$len-length($str);
                my $hwost='';
                for (my($a)=0; $a<$delta; $a++) {$hwost=$hwost.'0';};
                $str=$hwost.$str; return $str;
            };
     
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time());
    $RequestN=(1900+$year).dopprobelz($mon, 2);
    $RequestN=$RequestN.dopprobelz($mday, 2).dopprobelz($hour, 2);
    $RequestN=$RequestN.dopprobelz($min, 2).dopprobelz($sec, 2).dopprobelz($sec, 2);

    Дополняем время и дату ведущими нулями, где это требуется

    Мистер Хэнки, 13 Февраля 2011

    Комментарии (6)
  7. Perl / Говнокод #5644

    −123

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    my %tbl;
    $tbl{'koi'}="БВЧЗДЕЦЪЙКЛМНОПРТУФХЖИГЮЫЭШЩЯЬАСбвчздецъйклмнопртуфхжигюыэшщяьас";
    $tbl{'win'}="абвгдежзийклмнопрстуфхцчшщьыъэюяАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЬЫЪЭЮЯ";
    ...
        if ($filename=~/^http:\/\//) {
            my ($header, $page)=getpage($filename);
            if ($page!~/\S/) {next;}
            if ($header=~/Charset.*koi/i) {
                eval("\$page=~tr/$tbl{'koi'}/$tbl{'win'}/");            
            }
            open(OUT, ">$tmpfile");
            print OUT $page;
            close OUT;
            open(NEWS, "$tmpfile");
        } else {
            open(NEWS, "$config::rubricsroot/$filename") || do {warn "Не могу открыть файл новостей: $!"; next;};
        }

    #5624 спровоцировал. Хотел запостить только перекодировку, но не смог удержаться, тут перлы в комплексе.
    1) Свой велосипед для получения странички по http через IO::Socket (это отдельная большая песня, может спою потом).
    2) Перекодировка из koi8r в cp1251, если нужно. Обратите внимание на элегантный eval.
    3) Подстановка результата для дальнейшей построчной обработки через временный файл.

    И не говорите мне о том, какой плохой язык PHP.

    gegMOPO4, 11 Февраля 2011

    Комментарии (5)
  8. Perl / Говнокод #5550

    −119

    1. 1
    2. 2
    3. 3
    4. 4
    foreach $line (@data) {
    			@alldata = 0;
    			unshift @alldata;
    			@alldata = split(/\|/, $line);

    Инициализация массива.

    da4ever, 06 Февраля 2011

    Комментарии (11)
  9. Perl / Говнокод #5244

    −116

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    9. 9
    sub child_handler {
            #wait end of the child process
            my $waitedpid = wait;
            delete $my_childs{$waitedpid};
            $SIG{CHLD} = \&child_handler;
            LOG ("ripped $waitedpid" . ($? ? " with exit $?" : '')) if ($main::DEBUG>0);
    }
    
    $SIG{CHLD} = \&child_handler;

    Тарификатор плодящий зомби.
    Автор не поленился переустановить обработчик для сигнала.. хотя это не нужно. Всем читать учебники - как правильно рипать чайлдов в цикле.
    (с) Руслан Залата

    SanityIO, 12 Января 2011

    Комментарии (5)
  10. Perl / Говнокод #5243

    −126

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    if(syswrite($sock, $buf, length($buf)) > 0) {
         ...
    }
    else{
          # здесь автор считает что сокет сдох и закрывает его
           client_process_except($sock);
    }

    Но мы то с вами знаем что syswrite может вернуть 0
    (c) Руслан Залата

    SanityIO, 12 Января 2011

    Комментарии (1)