[ViewVC] Diff of: cvs/rxvt-unicode/src/urxvt.pm

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.265 by root, Sat Jul 24 09:48:43 2021 UTC vs.
Revision 1.266 by root, Sat Jul 24 11:58:27 2021 UTC

 =head1 DESCRIPTION
 Every time a terminal object gets created, extension scripts specified via
 the C<perl> resource are loaded and associated with it.
-Scripts are compiled in a 'use strict "vars"' and 'use utf8' environment, and
+Scripts are compiled in a 'use strict qw(vars subs)' and 'use utf8'
-thus must be encoded as UTF-8.
+environment, and thus must be encoded as UTF-8.
 Each script will only ever be loaded once, even in urxvtd, where
 scripts will be shared (but not enabled) for all terminals.
 You can disable the embedded perl interpreter by setting both "perl-ext"
 Rxvt-unicode recognizes special meta comments in extensions that define
 different types of metadata. These comments are scanned whenever a
 terminal is created and are typically used to autoload extensions when
 their resources or command line parameters are used.
-Currently, it recognises only one such comment:
+Currently, it recognises these comments below. Individual components are
+separated by cololns (C<:>), and shoudl not contain colons themselves -
+there is also currently no escaping mechanism provided for this.
 =over
 =item #:META:RESOURCE:name:type:desc
 C<name> is the resource name, C<type> is the resource type, C<boolean>
 or C<string>, and C<desc> is the resource description.
 The extension will be autoloaded when this resource is specified or used
 as a command line parameter.
+Example: matcher provides the C<matcher.launcher> ressource by having this
+comment:
+   #:META:RESOURCE:%.launcher:string:default launcher command
+Example: load this extension when the C<-tr> command line option or
+resource name is used.
+   #:META:RESOURCE:tr:boolean:set root pixmap as background
+=item #:META:OSC:number:desc
+The OSC comment specifies an OSC sequence, where C<number> is the
+numerical OSC code and C<desc> is a short description that is currently
+unused.
+This will cause the extension to be autoloaded when the OSC sequence is
+used for the first time.
+Note that autoloading carries some extra responsibilities with it:
+although the terminal cnanot really protect itself against malicious
+sources of command sequences, therefore relying on the programs running
+I<inside> to sanitize data that they output, it is very common for
+programs to emit command sequences from untrusted sources.
+While this means that extensions should, as a defense-in-depth mechanism,
+always consider whether OSC sequences are safe, autoloading automatically
+exposes any autoloaded extension in all terminal windows, so extra care
+should be taken.
+Example: the background extension registers OSC C<20> like this:
+   #:META:OSC:20:change/query background image
+=item #:META:OSC_PERL:prefix:desc
+The same as the OSC comment, but for the Perl OSC sequence (C<777>). The
+C<prefix> should be unique among extensions, of course, which is most
+easily arranged by using the extension name, although this is not
+required.
+Example: the overlay-osc extension registers its Perl OSC like this:
+   #:META:OSC_PERL:overlay:man overlay-osc
 =back
 =head2 Hooks
 C<on_osc_seq_perl> should be used for new behaviour.
 =item on_osc_seq_perl $term, $args, $resp
-Called whenever the B<ESC ] 777 ; string ST> command sequence (OSC =
+Called whenever the B<ESC ] 777 ; prefix ; string ST> command sequence
-operating system command) is processed. Cursor position and other state
+(OSC = operating system command) is processed. Cursor position and other
-information is up-to-date when this happens. For interoperability, the
+state information is up-to-date when this happens. For interoperability,
-string should start with the extension name (sans -osc) and a semicolon,
+the argument should start with the extension name (sans -osc) or some
-to distinguish it from commands for other extensions, and this might be
+other suitable prefix, and a semicolon, to distinguish it from commands
-enforced in the future.
+for other extensions.
 For example, C<overlay-osc> uses this:
    sub on_osc_seq_perl {
       my ($self, $osc, $resp) = @_;
 =cut
 package urxvt;
 use utf8;
-use strict 'vars';
+use strict qw(vars subs);
 use Carp ();
 use Scalar::Util ();
 use List::Util ();
 our $VERSION = 1;
          urxvt::log sprintf "  %-31s %s\n", "$pattern:", $type;
       }
    }
 }
-my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
+my $verbosity = $ENV{URXVT_PERL_VERBOSITY} // 2;
 sub verbose {
    my ($level, $msg) = @_;
    warn "$msg\n" if $level <= $verbosity;
 }
       open my $fh, "<:raw", $path
          or die "$path: $!";
       my $source =
-         "package $pkg; use strict 'vars'; use utf8; no warnings 'utf8';\n"
+         "package $pkg; use strict qw(vars subs); use utf8; no warnings 'utf8';\n"
          . "#line 1 \"$path\"\n{\n"
          . (do { local $/; <$fh> })
          . "\n};\n1";
       eval $source
 sub invoke {
    local $TERM = shift;
    my $htype = shift;
    if ($htype == HOOK_INIT) {
-      my @dirs = $TERM->perl_libdirs;
       $TERM->scan_extensions;
       my %ext_arg;
       {
                my $ext = $1;
                $ext_arg{$ext} = [];
             }
-         } elsif (/^-(.*)$/) {
+         } elsif (/^-(.*)$/) { # remove from set
             delete $ext_arg{$1};
-         } elsif (/^([^<]+)<(.*)>$/) {
+         } elsif (/^\/(.*)$/) { # prohibit loading
+            undef $TERM->{ext_prohibit}{$1};
+         } elsif (/^([^<]+)(?:<(.*)>)?$/) { # add to set, clear prohibit status
+            delete $TERM->{ext_prohibit}{$1};
-            push @{ $ext_arg{$1} }, $2;
+            push @{ $ext_arg{$1} }, defined $2 ? $2 : ();
          } else {
-            $ext_arg{$_} ||= [];
+            verbose 2, "cannot parse extension specification '$_', ignoring.";
          }
       }
+      $TERM->set_should_invoke (HOOK_OSC_SEQ     , +1) if $TERM->{meta}{autoload_osc};
+      $TERM->set_should_invoke (HOOK_OSC_SEQ_PERL, +1) if $TERM->{meta}{autoload_osc_perl};
       for my $ext (sort keys %ext_arg) {
-         my @files = grep -f $_, map "$_/$ext", @dirs;
+         my $path = $TERM->extension_path ($ext);
-         if (@files) {
+         if (defined $path) {
-            $TERM->register_package (extension_package $files[0], $ext_arg{$ext});
+            $TERM->autoload_extension ($ext, $ext_arg{$ext});
          } else {
-            warn "perl extension '$ext' not found in perl library search path\n";
+            verbose 2, "perl extension '$ext' not found in perl library search path";
          }
       }
       eval "#line 1 \"--perl-eval resource/argument\"\n" . $TERM->resource ("perl_eval");
       warn $@ if $@;
    }
    $retval = undef;
+   if ($htype == HOOK_OSC_SEQ) {
+      if (my $exts = delete $TERM->{meta}{autoload_osc}{$_[0]}) {
+         $TERM->autoload_extension ($_->[0]) for @$exts;
+      }
+   } elsif ($htype == HOOK_OSC_SEQ_PERL) {
+      if ($_[0] =~ /^([^;]+)/ and (my $exts = delete $TERM->{meta}{autoload_osc_perl}{$1})) {
+         $TERM->autoload_extension ($_->[0]) for @$exts;
+      }
+   }
    if (my $cb = $TERM->{_hook}[$htype]) {
       verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
          if $verbosity >= 10;
          $proxy->enable ($name => $ref);
       }
    }
 }
+# map extension name to filesyystem path
+sub extension_path {
+   (grep -f $_, map "$_/$_[1]", $_[0]->perl_libdirs)[0]
+}
+# load an extension by name
+sub load_extension_file {
+   my ($self, $path, $argv) = @_;
+   $self->register_package (urxvt::extension_package $path, $argv);
+}
+# autoload an extension unless loading it is prohibited
+sub autoload_extension {
+   my ($self, $name, $argv) = @_;
+   return if exists $self->{ext_prohibit}{$name};
+   my $path = $self->extension_path ($name)
+      // return urxvt::verbose 2, "perl extension '$name' not found in perl library search path (during autoload)";
+   $self->load_extension_file ($path, $argv);
+}
 sub perl_libdirs {
    map { split /:/ }
       $_[0]->resource ("perl_lib"),
       $ENV{URXVT_PERL_LIB},
       "$ENV{HOME}/.urxvt/ext",
    return if exists $self->{meta};
    my @urxvtdirs = perl_libdirs $self;
 #   my @cpandirs = grep -d, map "$_/URxvt/Ext", @INC;
-   $self->{meta} = \my %meta;
+   $self->{meta} = \my %allmeta;
    # first gather extensions
    my $gather = sub {
       my ($dir, $core) = @_;
             or next;
          $ext =~ s/\.uext$// or $core
             or next;
-         my %ext = (dir => $dir);
+         my %meta = (dir => $dir);
          while (<$fh>) {
             if (/^#:META:(?:X_)?RESOURCE:(.*)/) {
                my ($pattern, $type, $desc) = split /:/, $1;
                $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
                if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
                   warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n";
                } else {
-                  $ext{resource}{$pattern} = [$ext, $type, $desc];
+                  $meta{resource}{$pattern} = [$ext, $type, $desc];
                }
+            } elsif (/^#:META:OSC:([0-9]+):(.*)/) {
+               push @{$allmeta{autoload_osc}{$1}}, [$ext, $2];
+            } elsif (/^#:META:OSC_PERL:([^:]+):(.*)/) {
+               push @{$allmeta{autoload_osc_perl}{$1}}, [$ext, $2];
             } elsif (/^\s*(?:#|$)/) {
                # skip other comments and empty lines
             } else {
                last; # stop parsing on first non-empty non-comment line
             }
          }
-         $meta{ext}{$ext} = \%ext;
+         $allmeta{ext}{$ext} = \%meta;
       }
    };
 #   $gather->($_, 0) for @cpandirs;
    $gather->($_, 1) for @urxvtdirs;
    # and now merge resources
-   $meta{resource} = \my %resource;
+   $allmeta{resource} = \my %resource;
-   while (my ($k, $v) = each %{ $meta{ext} }) {
+   while (my ($k, $v) = each %{ $allmeta{ext} }) {
       #TODO: should check for extensions overriding each other
       %resource = (%resource, %{ $v->{resource} });
    }
 }
 This variable controls the verbosity level of the perl extension. Higher
 numbers indicate more verbose output.
 =over
-=item == 0 - fatal messages
+=item == 0 - fatal messages only
+=item >= 2 - general warnings (default level)
 =item >= 3 - script loading and management
 =item >=10 - all called hooks

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing rxvt-unicode/src/urxvt.pm (file contents): Revision 1.265 by root, Sat Jul 24 09:48:43 2021 UTC vs. Revision 1.266 by root, Sat Jul 24 11:58:27 2021 UTC

Diff Legend

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.265 by root, Sat Jul 24 09:48:43 2021 UTC vs.
Revision 1.266 by root, Sat Jul 24 11:58:27 2021 UTC