jina verze
This commit is contained in:
@@ -0,0 +1,501 @@
|
||||
#!/usr/bin/env perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my ($file, $mode, @args) = @ARGV;
|
||||
|
||||
defined $file && length $file or die "usage: $0 <file> <mode> ...\n";
|
||||
defined $mode && length $mode or die "mode is required\n";
|
||||
|
||||
sub mask_to_re {
|
||||
my ($mask) = @_;
|
||||
return undef if !defined($mask) || $mask eq '';
|
||||
$mask = quotemeta($mask);
|
||||
$mask =~ s/\\\*/.*/g;
|
||||
return qr/\A$mask\z/;
|
||||
}
|
||||
|
||||
sub parse_kv_line {
|
||||
my ($line, $wanted_key) = @_;
|
||||
return unless $line =~ /^(\h*)\Q$wanted_key\E(?:\h+(.*?))?\h*(?:\R)?$/;
|
||||
my $indent = $1;
|
||||
my $value = defined($2) ? $2 : '';
|
||||
return ($indent, $value);
|
||||
}
|
||||
|
||||
sub line_matches_delete {
|
||||
my ($line, $wanted_key, $value_re) = @_;
|
||||
my @m = parse_kv_line($line, $wanted_key) or return 0;
|
||||
return 1 unless $value_re;
|
||||
return $m[1] =~ $value_re;
|
||||
}
|
||||
|
||||
sub line_matches_exact {
|
||||
my ($line, $wanted_key, $wanted_value) = @_;
|
||||
my @m = parse_kv_line($line, $wanted_key) or return 0;
|
||||
return $m[1] eq $wanted_value;
|
||||
}
|
||||
|
||||
sub fmt_line {
|
||||
my ($indent, $k, $v) = @_;
|
||||
return sprintf("%s%-23s %s\n", $indent, $k, $v);
|
||||
}
|
||||
|
||||
sub brace_delta {
|
||||
my ($line) = @_;
|
||||
my $o = () = $line =~ /\{/g;
|
||||
my $c = () = $line =~ /\}/g;
|
||||
return $o - $c;
|
||||
}
|
||||
|
||||
sub find_section {
|
||||
my ($lines, $re) = @_;
|
||||
|
||||
for (my $i = 0; $i <= $#$lines; $i++) {
|
||||
next unless $lines->[$i] =~ /^(\h*)$re\h*\{\h*(?:\R)?$/;
|
||||
|
||||
my $indent = $1 . ' ';
|
||||
my $depth = 1;
|
||||
|
||||
for (my $j = $i + 1; $j <= $#$lines; $j++) {
|
||||
$depth += brace_delta($lines->[$j]);
|
||||
if ($depth == 0) {
|
||||
return ($i, $j, $indent);
|
||||
}
|
||||
}
|
||||
|
||||
die "section '$re' is not closed\n";
|
||||
}
|
||||
|
||||
die "section '$re' not found\n";
|
||||
}
|
||||
|
||||
sub delete_key {
|
||||
my ($lines, $section_re, $key, $mask) = @_;
|
||||
my $value_re = mask_to_re($mask);
|
||||
|
||||
if ($section_re eq '') {
|
||||
my @out;
|
||||
my $depth = 0;
|
||||
|
||||
for my $line (@$lines) {
|
||||
my $remove = ($depth == 0 && line_matches_delete($line, $key, $value_re)) ? 1 : 0;
|
||||
push @out, $line unless $remove;
|
||||
$depth += brace_delta($line);
|
||||
}
|
||||
|
||||
@$lines = @out;
|
||||
return;
|
||||
}
|
||||
|
||||
my ($start, $end, undef) = find_section($lines, $section_re);
|
||||
|
||||
my @out;
|
||||
push @out, @$lines[0 .. $start];
|
||||
|
||||
my $depth = 1;
|
||||
for my $i ($start + 1 .. $end - 1) {
|
||||
my $line = $lines->[$i];
|
||||
my $remove = ($depth == 1 && line_matches_delete($line, $key, $value_re)) ? 1 : 0;
|
||||
push @out, $line unless $remove;
|
||||
$depth += brace_delta($line);
|
||||
}
|
||||
|
||||
push @out, @$lines[$end .. $#$lines];
|
||||
@$lines = @out;
|
||||
}
|
||||
|
||||
sub add_key {
|
||||
my ($lines, $section_re, $key, $value) = @_;
|
||||
die "value is required for add\n" if !defined($value) || $value eq '';
|
||||
|
||||
if ($section_re eq '') {
|
||||
my $depth = 0;
|
||||
|
||||
for my $line (@$lines) {
|
||||
if ($depth == 0 && line_matches_exact($line, $key, $value)) {
|
||||
return;
|
||||
}
|
||||
$depth += brace_delta($line);
|
||||
}
|
||||
|
||||
my $new = fmt_line('', $key, $value);
|
||||
|
||||
my $root_pos;
|
||||
my $first_section_pos;
|
||||
$depth = 0;
|
||||
|
||||
for (my $i = 0; $i <= $#$lines; $i++) {
|
||||
my $line = $lines->[$i];
|
||||
|
||||
if ($depth == 0) {
|
||||
$root_pos = $i
|
||||
if !defined($root_pos) && $line =~ /^\h*serverName\h+\S*/;
|
||||
|
||||
$first_section_pos = $i
|
||||
if !defined($first_section_pos) && $line =~ /^\h*\S.*\{\h*(?:\R)?$/;
|
||||
}
|
||||
|
||||
$depth += brace_delta($line);
|
||||
}
|
||||
|
||||
if (defined $root_pos) {
|
||||
splice @$lines, $root_pos + 1, 0, $new;
|
||||
} elsif (defined $first_section_pos) {
|
||||
splice @$lines, $first_section_pos, 0, $new;
|
||||
} else {
|
||||
push @$lines, $new;
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
my ($start, $end, $indent) = find_section($lines, $section_re);
|
||||
|
||||
my $depth = 1;
|
||||
for my $i ($start + 1 .. $end - 1) {
|
||||
my $line = $lines->[$i];
|
||||
if ($depth == 1 && line_matches_exact($line, $key, $value)) {
|
||||
return;
|
||||
}
|
||||
$depth += brace_delta($line);
|
||||
}
|
||||
|
||||
my $new = fmt_line($indent, $key, $value);
|
||||
splice @$lines, $end, 0, $new;
|
||||
}
|
||||
|
||||
sub build_vhost_section {
|
||||
my ($domain) = @_;
|
||||
return if !defined($domain) || $domain eq '';
|
||||
|
||||
my @out;
|
||||
push @out, "virtualhost $domain {\n";
|
||||
push @out, fmt_line(' ', 'vhRoot', "/var/www/vhosts/$domain");
|
||||
push @out, fmt_line(' ', 'configFile', "/usr/local/lsws/conf/vhosts/$domain.conf");
|
||||
push @out, fmt_line(' ', 'allowSymbolLink', '1');
|
||||
push @out, fmt_line(' ', 'enableScript', '1');
|
||||
push @out, fmt_line(' ', 'restrained', '1');
|
||||
push @out, fmt_line(' ', 'setUIDMode', '2');
|
||||
push @out, "}\n";
|
||||
|
||||
return join('', @out);
|
||||
}
|
||||
|
||||
sub has_vhost_section {
|
||||
my ($lines, $name) = @_;
|
||||
|
||||
for my $line (@$lines) {
|
||||
return 1 if $line =~ /^\h*virtualhost\h+\Q$name\E\h*\{/;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub add_vhost_section {
|
||||
my ($lines, $name) = @_;
|
||||
|
||||
return if !defined($name) || $name eq '';
|
||||
return if has_vhost_section($lines, $name);
|
||||
|
||||
my @section = split /(?<=\n)/, build_vhost_section($name), -1;
|
||||
pop @section if @section && $section[-1] eq '';
|
||||
|
||||
if (@$lines && $lines->[-1] !~ /\n\z/) {
|
||||
$lines->[-1] .= "\n";
|
||||
}
|
||||
|
||||
push @$lines, "\n" if @$lines && $lines->[-1] !~ /^\s*$/;
|
||||
push @$lines, @section;
|
||||
}
|
||||
|
||||
sub delete_named_section {
|
||||
my ($lines, $header_re) = @_;
|
||||
|
||||
my @out;
|
||||
my $deleted = 0;
|
||||
|
||||
for (my $i = 0; $i <= $#$lines; $i++) {
|
||||
my $line = $lines->[$i];
|
||||
|
||||
if ($line =~ /^\h*$header_re\h*\{\h*(?:\R)?$/) {
|
||||
my $depth = 1;
|
||||
$deleted = 1;
|
||||
|
||||
for ($i = $i + 1; $i <= $#$lines; $i++) {
|
||||
$depth += brace_delta($lines->[$i]);
|
||||
last if $depth == 0;
|
||||
}
|
||||
|
||||
next;
|
||||
}
|
||||
|
||||
push @out, $line;
|
||||
}
|
||||
|
||||
@$lines = @out;
|
||||
return $deleted;
|
||||
}
|
||||
|
||||
sub get_suspended_vhosts {
|
||||
my ($lines) = @_;
|
||||
|
||||
my $depth = 0;
|
||||
for my $line (@$lines) {
|
||||
if ($depth == 0) {
|
||||
my @m = parse_kv_line($line, 'suspendedVhosts');
|
||||
if (@m) {
|
||||
return grep { length }
|
||||
map { s/^\h+|\h+$//gr }
|
||||
split /,/, $m[1];
|
||||
}
|
||||
}
|
||||
$depth += brace_delta($line);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub set_suspended_vhosts {
|
||||
my ($lines, @list) = @_;
|
||||
|
||||
@list = grep { defined($_) && $_ ne '' } @list;
|
||||
|
||||
delete_key($lines, '', 'suspendedVhosts', '');
|
||||
|
||||
if (@list) {
|
||||
add_key($lines, '', 'suspendedVhosts', join(',', @list));
|
||||
}
|
||||
}
|
||||
|
||||
sub suspend_vhost {
|
||||
my ($lines, $domain) = @_;
|
||||
return if !defined($domain) || $domain eq '';
|
||||
|
||||
my @current = get_suspended_vhosts($lines);
|
||||
|
||||
my @new = ($domain);
|
||||
for my $item (@current) {
|
||||
push @new, $item if $item ne $domain;
|
||||
}
|
||||
|
||||
set_suspended_vhosts($lines, @new);
|
||||
}
|
||||
|
||||
sub unsuspend_vhost {
|
||||
my ($lines, $domain) = @_;
|
||||
return if !defined($domain) || $domain eq '';
|
||||
|
||||
my @current = get_suspended_vhosts($lines);
|
||||
my @new = grep { $_ ne $domain } @current;
|
||||
|
||||
set_suspended_vhosts($lines, @new);
|
||||
}
|
||||
|
||||
sub get_listener_http_maps {
|
||||
my ($lines) = @_;
|
||||
|
||||
my ($start, $end, undef) = find_section($lines, 'listener\h+HTTP');
|
||||
|
||||
my @maps;
|
||||
|
||||
for my $i ($start + 1 .. $end - 1) {
|
||||
my $clean = $lines->[$i];
|
||||
$clean =~ s/#.*$//;
|
||||
$clean =~ s/^\s+|\s+$//g;
|
||||
next if $clean eq '';
|
||||
|
||||
if ($clean =~ /^map\s+(\S+)\s+(\S+)$/i) {
|
||||
push @maps, [$1, $2];
|
||||
}
|
||||
}
|
||||
|
||||
return @maps;
|
||||
}
|
||||
|
||||
sub vhost_list {
|
||||
my ($lines, $type) = @_;
|
||||
$type //= 'all';
|
||||
|
||||
die "unknown vhost list type '$type'\n"
|
||||
if $type !~ /\A(?:all|up|down)\z/;
|
||||
|
||||
my @all;
|
||||
my %down = map { $_ => 1 } get_suspended_vhosts($lines);
|
||||
|
||||
for my $line (@$lines) {
|
||||
my $clean = $line;
|
||||
$clean =~ s/#.*$//;
|
||||
$clean =~ s/^\s+|\s+$//g;
|
||||
next if $clean eq '';
|
||||
|
||||
if ($clean =~ /^virtualhost\s+([^\s\{]+)\s*\{?/i) {
|
||||
push @all, $1;
|
||||
}
|
||||
}
|
||||
|
||||
if ($type eq 'all') {
|
||||
print "$_\n" for @all;
|
||||
} elsif ($type eq 'down') {
|
||||
print "$_\n" for grep { exists $down{$_} } @all;
|
||||
} elsif ($type eq 'up') {
|
||||
print "$_\n" for grep { !exists $down{$_} } @all;
|
||||
}
|
||||
}
|
||||
|
||||
sub vhost_list_map {
|
||||
my ($lines, $type) = @_;
|
||||
$type //= 'all';
|
||||
|
||||
die "unknown vhost map list type '$type'\n"
|
||||
if $type !~ /\A(?:all|up|down)\z/;
|
||||
|
||||
my %down = map { $_ => 1 } get_suspended_vhosts($lines);
|
||||
my %seen;
|
||||
|
||||
for my $map (get_listener_http_maps($lines)) {
|
||||
my ($vhost, $domain) = @$map;
|
||||
|
||||
next if $vhost ne $domain;
|
||||
next if $seen{$vhost}++;
|
||||
|
||||
if ($type eq 'down') {
|
||||
next if !exists $down{$vhost};
|
||||
} elsif ($type eq 'up') {
|
||||
next if exists $down{$vhost};
|
||||
}
|
||||
|
||||
print "$vhost\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub alias_list {
|
||||
my ($lines) = @_;
|
||||
|
||||
my %seen;
|
||||
|
||||
for my $map (get_listener_http_maps($lines)) {
|
||||
my ($vhost, $domain) = @$map;
|
||||
|
||||
next if $vhost eq $domain;
|
||||
next if $seen{$domain}++;
|
||||
|
||||
print "$domain\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub vhost_alias {
|
||||
my ($lines, $name) = @_;
|
||||
|
||||
die "virtual host name is required\n"
|
||||
if !defined($name) || $name eq '';
|
||||
|
||||
my %seen;
|
||||
|
||||
for my $map (get_listener_http_maps($lines)) {
|
||||
my ($vhost, $domain) = @$map;
|
||||
|
||||
next if $vhost ne $name;
|
||||
next if $domain eq $name;
|
||||
next if $seen{$domain}++;
|
||||
|
||||
print "$domain\n";
|
||||
}
|
||||
}
|
||||
|
||||
open my $fh, '<', $file or die "cannot read '$file': $!\n";
|
||||
local $/;
|
||||
my $content = <$fh>;
|
||||
close $fh;
|
||||
|
||||
my @L = split /(?<=\n)/, $content, -1;
|
||||
|
||||
if ($mode eq 'del') {
|
||||
my ($section_re, $key, $mask) = @args;
|
||||
defined $section_re or die "section_re is required\n";
|
||||
defined $key or die "key is required\n";
|
||||
$mask //= '';
|
||||
delete_key(\@L, $section_re, $key, $mask);
|
||||
}
|
||||
elsif ($mode eq 'add') {
|
||||
my ($section_re, $key, $value) = @args;
|
||||
defined $section_re or die "section_re is required\n";
|
||||
defined $key or die "key is required\n";
|
||||
defined $value or die "value is required\n";
|
||||
add_key(\@L, $section_re, $key, $value);
|
||||
}
|
||||
elsif ($mode eq 'set') {
|
||||
my ($section_re, $key, $value) = @args;
|
||||
defined $section_re or die "section_re is required\n";
|
||||
defined $key or die "key is required\n";
|
||||
defined $value or die "value is required\n";
|
||||
delete_key(\@L, $section_re, $key, '');
|
||||
add_key(\@L, $section_re, $key, $value);
|
||||
}
|
||||
elsif ($mode eq 'set_masked') {
|
||||
my ($section_re, $key, $mask, $value) = @args;
|
||||
defined $section_re or die "section_re is required\n";
|
||||
defined $key or die "key is required\n";
|
||||
defined $mask or die "mask is required\n";
|
||||
defined $value or die "value is required\n";
|
||||
delete_key(\@L, $section_re, $key, $mask);
|
||||
add_key(\@L, $section_re, $key, $value);
|
||||
}
|
||||
elsif ($mode eq 'del_masked') {
|
||||
my ($section_re, $key, $mask) = @args;
|
||||
defined $section_re or die "section_re is required\n";
|
||||
defined $key or die "key is required\n";
|
||||
defined $mask or die "mask is required\n";
|
||||
delete_key(\@L, $section_re, $key, $mask);
|
||||
}
|
||||
elsif ($mode eq 'vhost_add') {
|
||||
my ($name) = @args;
|
||||
defined $name && length $name or die "virtual host name is required\n";
|
||||
add_vhost_section(\@L, $name);
|
||||
}
|
||||
elsif ($mode eq 'vhost_del') {
|
||||
my ($name) = @args;
|
||||
defined $name && length $name or die "virtual host name is required\n";
|
||||
my $quoted = quotemeta($name);
|
||||
delete_named_section(\@L, "virtualhost\\h+$quoted");
|
||||
}
|
||||
elsif ($mode eq 'vhost_down') {
|
||||
my ($name) = @args;
|
||||
defined $name && length $name or die "virtual host name is required\n";
|
||||
suspend_vhost(\@L, $name);
|
||||
}
|
||||
elsif ($mode eq 'vhost_up') {
|
||||
my ($name) = @args;
|
||||
defined $name && length $name or die "virtual host name is required\n";
|
||||
unsuspend_vhost(\@L, $name);
|
||||
}
|
||||
elsif ($mode eq 'vhost_list') {
|
||||
my ($type) = @args;
|
||||
vhost_list(\@L, $type // 'all');
|
||||
exit 0;
|
||||
}
|
||||
elsif ($mode eq 'vhost_list_map') {
|
||||
my ($type) = @args;
|
||||
vhost_list_map(\@L, $type // 'all');
|
||||
exit 0;
|
||||
}
|
||||
elsif ($mode eq 'alias_list') {
|
||||
alias_list(\@L);
|
||||
exit 0;
|
||||
}
|
||||
elsif ($mode eq 'vhost_alias') {
|
||||
my ($name) = @args;
|
||||
vhost_alias(\@L, $name);
|
||||
exit 0;
|
||||
}
|
||||
else {
|
||||
die "unknown mode '$mode'\n";
|
||||
}
|
||||
|
||||
$content = join '', @L;
|
||||
|
||||
open my $out, '>', $file or die "cannot write '$file': $!\n";
|
||||
print {$out} $content;
|
||||
close $out or die "cannot close '$file': $!\n";
|
||||
|
||||
exit 0;
|
||||
Reference in New Issue
Block a user