jina verze

This commit is contained in:
2026-08-12 10:53:04 +02:00
parent f186ec26a8
commit 93d4f24f07
43 changed files with 1686 additions and 1959 deletions
+245 -325
View File
@@ -9,7 +9,7 @@ defined $mode && length $mode or die "mode is required\n";
sub mask_to_re {
my ($mask) = @_;
return if !defined($mask) || $mask eq '';
return undef if !defined($mask) || $mask eq '';
$mask = quotemeta($mask);
$mask =~ s/\\\*/.*/g;
return qr/\A$mask\z/;
@@ -43,70 +43,34 @@ sub fmt_line {
sub brace_delta {
my ($line) = @_;
return ($line =~ tr/\{//) - ($line =~ tr/\}//);
my $o = () = $line =~ /\{/g;
my $c = () = $line =~ /\}/g;
return $o - $c;
}
sub key_add {
my ($lines, $section_re, $key, $value) = @_;
# die "value is required for add\n" if !defined($value) || $value eq '';
sub find_section {
my ($lines, $re) = @_;
if ($section_re eq '') {
my $depth = 0;
for (my $i = 0; $i <= $#$lines; $i++) {
next unless $lines->[$i] =~ /^(\h*)$re\h*\{\h*(?:\R)?$/;
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_block_pos;
$depth = 0;
for (my $i = 0; $i <= $#$lines; $i++) {
my $line = $lines->[$i];
my $indent = $1 . ' ';
my $depth = 1;
for (my $j = $i + 1; $j <= $#$lines; $j++) {
$depth += brace_delta($lines->[$j]);
if ($depth == 0) {
$root_pos = $i
if !defined($root_pos) && $line =~ /^\h*serverName\h+\S*/;
$first_block_pos = $i
if !defined($first_block_pos) && $line =~ /^\h*\S.*\{\h*(?:\R)?$/;
return ($i, $j, $indent);
}
$depth += brace_delta($line);
}
if (defined $root_pos) {
splice @$lines, $root_pos + 1, 0, $new;
} elsif (defined $first_block_pos) {
splice @$lines, $first_block_pos, 0, $new;
} else {
push @$lines, $new;
}
return;
die "section '$re' is not closed\n";
}
my ($start, $end, $indent) = block_find($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;
die "section '$re' not found\n";
}
sub key_del {
sub delete_key {
my ($lines, $section_re, $key, $mask) = @_;
my $value_re = mask_to_re($mask);
@@ -124,7 +88,7 @@ sub key_del {
return;
}
my ($start, $end, undef) = block_find($lines, $section_re);
my ($start, $end, undef) = find_section($lines, $section_re);
my @out;
push @out, @$lines[0 .. $start];
@@ -141,45 +105,111 @@ sub key_del {
@$lines = @out;
}
sub block_find {
my ($lines, $re) = @_;
sub add_key {
my ($lines, $section_re, $key, $value) = @_;
die "value is required for add\n" if !defined($value) || $value eq '';
for (my $i = 0; $i <= $#$lines; $i++) {
next unless $lines->[$i] =~ /^(\h*)$re\h*\{\h*(?:\R)?$/;
if ($section_re eq '') {
my $depth = 0;
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);
for my $line (@$lines) {
if ($depth == 0 && line_matches_exact($line, $key, $value)) {
return;
}
$depth += brace_delta($line);
}
die "block '$re' is not closed\n";
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;
}
die "block '$re' not found\n";
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 block_add {
my ($lines, $header) = @_;
return if !defined($header) || $header eq '';
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 if $line =~ /^\h*\Q$header\E\h*\{/;
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, "$header {\n";
push @$lines, "}\n";
push @$lines, @section;
}
sub block_del {
sub delete_named_section {
my ($lines, $header_re) = @_;
my @out;
@@ -207,19 +237,7 @@ sub block_del {
return $deleted;
}
sub suspended_rebuild {
my ($lines, @list) = @_;
@list = grep { defined($_) && $_ ne '' } @list;
key_del($lines, '', 'suspendedVhosts', '');
if (@list) {
key_add($lines, '', 'suspendedVhosts', join(',', @list));
}
}
sub suspended_list {
sub get_suspended_vhosts {
my ($lines) = @_;
my $depth = 0;
@@ -238,20 +256,61 @@ sub suspended_list {
return;
}
sub suspended_add {
my ($lines, $domain) = @_;
return if !defined($domain) || $domain eq '';
sub set_suspended_vhosts {
my ($lines, @list) = @_;
my @current = suspended_list($lines);
return if grep { $_ eq $domain } @current;
suspended_rebuild($lines, @current, $domain);
@list = grep { defined($_) && $_ ne '' } @list;
delete_key($lines, '', 'suspendedVhosts', '');
if (@list) {
add_key($lines, '', 'suspendedVhosts', join(',', @list));
}
}
sub suspended_del {
sub suspend_vhost {
my ($lines, $domain) = @_;
return if !defined($domain) || $domain eq '';
suspended_rebuild($lines, grep { $_ ne $domain } suspended_list($lines));
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 {
@@ -262,7 +321,7 @@ sub vhost_list {
if $type !~ /\A(?:all|up|down)\z/;
my @all;
my %down = map { $_ => 1 } suspended_list($lines);
my %down = map { $_ => 1 } get_suspended_vhosts($lines);
for my $line (@$lines) {
my $clean = $line;
@@ -284,30 +343,44 @@ sub vhost_list {
}
}
sub vhost_del {
my ($lines, $domain) = @_;
sub vhost_list_map {
my ($lines, $type) = @_;
$type //= 'all';
key_del($lines, 'listener\h+HTTP', 'map', "$domain *");
block_del($lines, 'virtualhost\h+' . quotemeta($domain));
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 vhost_set {
my ($lines, $vhRoot, $domain, @aliases) = @_;
sub alias_list {
my ($lines) = @_;
vhost_del($lines, $domain);
block_add($lines, "virtualhost $domain");
my %seen;
my $block_re = 'virtualhost\h+' . quotemeta($domain);
key_add($lines, $block_re, 'vhRoot', $vhRoot);
key_add($lines, $block_re, 'configFile', "/usr/local/lsws/conf/vhosts/$domain.conf");
key_add($lines, $block_re, 'allowSymbolLink', '1');
key_add($lines, $block_re, 'enableScript', '1');
key_add($lines, $block_re, 'restrained', '1');
key_add($lines, $block_re, 'setUIDMode', '2');
for my $map (get_listener_http_maps($lines)) {
my ($vhost, $domain) = @$map;
key_add($lines, 'listener\h+HTTP', 'map', "$domain $domain");
for my $alias (@aliases) {
key_add($lines, 'listener\h+HTTP', 'map', "$domain $alias");
next if $vhost eq $domain;
next if $seen{$domain}++;
print "$domain\n";
}
}
@@ -317,140 +390,19 @@ sub vhost_alias {
die "virtual host name is required\n"
if !defined($name) || $name eq '';
my ($start, $end) = block_find($lines, 'listener\h+HTTP');
my %seen;
for my $i ($start + 1 .. $end - 1) {
my $clean = $lines->[$i];
$clean =~ s/#.*$//;
$clean =~ s/^\s+|\s+$//g;
next if $clean eq '';
next unless $clean =~ /^map\s+(\S+)\s+(\S+)$/i;
for my $map (get_listener_http_maps($lines)) {
my ($vhost, $domain) = @$map;
my ($vhost, $domain) = ($1, $2);
next if $name ne 'all' && $vhost ne $name;
next if $domain eq $vhost;
next if $vhost ne $name;
next if $domain eq $name;
next if $seen{$domain}++;
print "$domain\n";
}
}
sub member_list {
my ($lines, $template, $type) = @_;
my ($t_start, $t_end) = block_find($lines, 'vhTemplate\h+' . quotemeta($template));
die "unknown member list type '$type'\n"
if $type !~ /\A(?:all|up|down)\z/;
my %down = map { $_ => 1 } suspended_list($lines);
my $depth = 0;
for my $i ($t_start + 1 .. $t_end - 1) {
my $line = $lines->[$i];
if ($depth == 0 && $line =~ /^\h*member\h+([^\s\{]+)/i) {
my $name = $1;
if ( $type eq 'all'
|| ($type eq 'down' && exists $down{$name})
|| ($type eq 'up' && !exists $down{$name})) {
print "$name\n";
}
}
$depth += brace_delta($line);
}
}
sub member_del {
my ($lines, $template, $domain) = @_;
my ($t_start, $t_end) = block_find($lines, 'vhTemplate\h+' . quotemeta($template));
my $depth = 0;
for my $i ($t_start + 1 .. $t_end - 1) {
my $line = $lines->[$i];
if ($depth == 0 && $line =~ /^\h*member\h+\Q$domain\E\h*(\{)?\h*(?:\R)?$/) {
my $m_end = $i;
if (defined $1) {
my $d = 1;
for my $j ($i + 1 .. $t_end - 1) {
$d += brace_delta($lines->[$j]);
if ($d == 0) { $m_end = $j; last; }
}
die "member '$domain' block is not closed\n" if $m_end == $i;
}
splice @$lines, $i, $m_end - $i + 1;
return;
}
$depth += brace_delta($line);
}
}
sub member_set {
my ($lines, $template, $domain, @aliases) = @_;
member_del($lines, $template, $domain);
my ($t_start, $t_end, $indent) = block_find($lines, 'vhTemplate\h+' . quotemeta($template));
my @new;
if (@aliases) {
push @new, fmt_line($indent, 'member', "$domain {");
push @new, fmt_line($indent . ' ', 'vhAliases', join(', ', @aliases));
push @new, "$indent}\n";
} else {
push @new, fmt_line($indent, 'member', $domain);
}
splice @$lines, $t_end, 0, @new;
}
sub member_alias {
my ($lines, $template, $domain) = @_;
my ($t_start, $t_end) = block_find($lines, 'vhTemplate\h+' . quotemeta($template));
my $depth = 0;
for my $i ($t_start + 1 .. $t_end - 1) {
my $line = $lines->[$i];
if ($depth == 0 && $line =~ /^\h*member\h+(\S+)\h*\{\h*(?:\R)?$/) {
my $mname = $1;
my $match = ($domain eq 'all' || $domain eq $mname);
if ($match) {
my $d = 1;
for my $j ($i + 1 .. $t_end - 1) {
if ($d == 1) {
my @m = parse_kv_line($lines->[$j], 'vhAliases');
if (@m) {
for my $a (split /\h*,\h*/, $m[1]) {
next if $a eq '';
print "$a\n";
}
last;
}
}
$d += brace_delta($lines->[$j]);
last if $d == 0;
}
return unless $domain eq 'all';
}
}
$depth += brace_delta($line);
}
}
open my $fh, '<', $file or die "cannot read '$file': $!\n";
local $/;
my $content = <$fh>;
@@ -458,121 +410,89 @@ close $fh;
my @L = split /(?<=\n)/, $content, -1;
if ($mode eq 'key_add') {
my ($block_re, $key, $value) = @args;
defined $block_re or die "block_re is required\n";
defined $key or die "key is required\n";
defined $value or die "value is required\n";
key_add(\@L, $block_re, $key, $value);
}
elsif ($mode eq 'key_set') {
my ($block_re, $key, $value) = @args;
defined $block_re or die "block_re is required\n";
defined $key or die "key is required\n";
defined $value or die "value is required\n";
key_del(\@L, $block_re, $key, '');
key_add(\@L, $block_re, $key, $value);
}
elsif ($mode eq 'key_mask_set') {
my ($block_re, $key, $mask, $value) = @args;
defined $block_re or die "block_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";
key_del(\@L, $block_re, $key, $mask);
key_add(\@L, $block_re, $key, $value);
}
elsif ($mode eq 'key_del') {
my ($block_re, $key, $mask) = @args;
defined $block_re or die "block_re is required\n";
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 //= '';
key_del(\@L, $block_re, $key, $mask);
delete_key(\@L, $section_re, $key, $mask);
}
elsif ($mode eq 'key_mask_del') {
my ($block_re, $key, $mask) = @args;
defined $block_re or die "block_re is required\n";
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";
key_del(\@L, $block_re, $key, $mask);
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 'block_add') {
my ($header) = @args;
defined $header && length $header or die "block header is required\n";
block_add(\@L, $header);
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 'block_del') {
my ($header_re) = @args;
defined $header_re && length $header_re or die "block header pattern is required\n";
block_del(\@L, $header_re);
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 'suspended_list') {
print "$_\n" for suspended_list(\@L);
exit 0;
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 'suspended_del') {
my ($domain) = @args;
defined $domain && length $domain or die "domain is required\n";
suspended_del(\@L, $domain);
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 'suspended_add') {
my ($domain) = @args;
defined $domain && length $domain or die "domain is required\n";
suspended_add(\@L, $domain);
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_del') {
my ($domain) = @args;
defined $domain && length $domain or die "domain is required\n";
vhost_del(\@L, $domain);
elsif ($mode eq 'vhost_list_map') {
my ($type) = @args;
vhost_list_map(\@L, $type // 'all');
exit 0;
}
elsif ($mode eq 'vhost_set') {
my ($vhRoot, $domain, @aliases) = @args;
defined $vhRoot && length $vhRoot or die "vhRoot is required\n";
defined $domain && length $domain or die "domain is required\n";
vhost_set(\@L, $vhRoot, $domain, @aliases);
elsif ($mode eq 'alias_list') {
alias_list(\@L);
exit 0;
}
elsif ($mode eq 'vhost_alias') {
my ($name) = @args;
vhost_alias(\@L, $name);
exit 0;
}
elsif ($mode eq 'member_list') {
my ($template, $type) = @args;
defined $template && length $template or die "template is required\n";
defined $type && length $type or die "type is required\n";
member_list(\@L, $template, $type);
exit 0;
}
elsif ($mode eq 'member_del') {
my ($template, $domain) = @args;
defined $template && length $template or die "template is required\n";
defined $domain && length $domain or die "domain is required\n";
member_del(\@L, $template, $domain);
}
elsif ($mode eq 'member_set') {
my ($template, $domain, @aliases) = @args;
defined $template && length $template or die "template is required\n";
defined $domain && length $domain or die "domain is required\n";
member_set(\@L, $template, $domain, @aliases);
}
elsif ($mode eq 'member_alias') {
my ($template, $domain) = @args;
defined $template && length $template or die "template is required\n";
defined $domain && length $domain or die "domain is required\n";
member_alias(\@L, $template, $domain);
exit 0;
}
else {
die "unknown mode '$mode'\n";
}
$content = join '', @L;
$content =~ s/\n{3,}/\n\n/g;
open my $out, '>', $file or die "cannot write '$file': $!\n";
print {$out} $content;