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

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.264 by root, Sat Jul 24 09:42:15 2021 UTC vs.
Revision 1.269 by root, Sun Nov 21 15:15:02 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"
 terminal is destroyed.
 Argument names also often indicate the type of a parameter. Here are some
 hints on what they mean:
-=over 4
+=over
 =item $text
 Rxvt-unicode's special way of encoding text, where one "unicode" character
 always represents one screen cell. See L<ROW_t> for a discussion of this format.
 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 colons (C<:>), and should not contain colons themselves -
+there is also currently no escaping mechanism provided for this.
-=over 4
+=over
 =item #:META:RESOURCE:name:type:desc
 The RESOURCE comment defines a resource used by the extension, where
 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> resource 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 cannot 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
 The following subroutines can be declared in extension files, and will be
 hooks returns true, then the event counts as being I<consumed>, and the
 relevant action might not be carried out by the C++ code.
 I<< When in doubt, return a false value (preferably C<()>). >>
-=over 4
+=over
 =item on_init $term
 Called after a new terminal object has been initialized, but before
 windows are created or the command gets run. Most methods are unsafe to
 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;
 our $NOCHAR = chr 0xffff;
 =head2 Variables in the C<urxvt> Package
-=over 4
+=over
 =item $urxvt::LIBDIR
 The rxvt-unicode library directory, where, among other things, the perl
 modules and scripts are stored.
 =back
 =head2 Functions in the C<urxvt> Package
-=over 4
+=over
 =item urxvt::fatal $errormessage
 Fatally aborts execution with the given error message (which should
 include a trailing newline). Avoid at all costs! The only time this
 The following "macros" deal with changes in rendition sets. You should
 never just create a bitset, you should always modify an existing one,
 as they contain important information required for correct operation of
 rxvt-unicode.
-=over 4
+=over
 =item $rend = urxvt::DEFAULT_RSTYLE
 Returns the default rendition, as used when the terminal is starting up or
 being reset. Useful as a base to start when creating renditions.
          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 $@;
+   }
+   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;
+      }
    }
    $retval = undef;
    if (my $cb = $TERM->{_hook}[$htype]) {
 The methods (And data members) documented below can be called on extension
 objects, in addition to call methods documented for the <urxvt::term>
 class.
-=over 4
+=over
 =item $urxvt_term = $self->{term}
 Returns the C<urxvt::term> object associated with this instance of the
 extension. This member I<must not> be changed in any way.
 package urxvt::term;
 =head2 The C<urxvt::term> Class
-=over 4
+=over
 =cut
 # find on_xxx subs in the package and register them
 # as hooks
          $proxy->enable ($name => $ref);
       }
    }
 }
+# map extension name to filesystem 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 method returns an urxvt::overlay object. The overlay will be visible
 as long as the perl object is referenced.
 The methods currently supported on C<urxvt::overlay> objects are:
-=over 4
+=over
 =item $overlay->set ($x, $y, $text[, $rend])
 Similar to C<< $term->ROW_t >> and C<< $term->ROW_r >> in that it puts
 text in rxvt-unicode's special encoding and an array of rendition values
 Returns the number of screen-cells this string would need. Correctly
 accounts for wide and combining characters.
 =item $octets = $term->locale_encode ($string)
-Convert the given text string into the corresponding locale encoding.
+Convert the given text string into the corresponding locale
+encoding. Returns C<undef> if C<$string> is C<undef>.
 =item $string = $term->locale_decode ($octets)
-Convert the given locale-encoded octets into a perl string.
+Convert the given locale-encoded octets into a perl string. Returns
+C<undef> if C<$octets> is C<undef>.
 =item $term->scr_xor_span ($beg_row, $beg_col, $end_row, $end_col[, $rstyle])
 XORs the rendition values in the given span with the provided value
 (default: C<RS_RVid>), which I<MUST NOT> contain font styles. Useful in
 Create and return a new C<urxvt::line> object that stores information
 about the logical line that row C<$row_number> is part of. It supports the
 following methods:
-=over 4
+=over
 =item $text = $line->t ([$new_text])
 Returns or replaces the full text of the line, similar to C<ROW_t>
 where one character corresponds to one screen cell. See
 C<< $term->ROW_t >> for details.
 =item $string = $term->special_decode $text
-Converts rxvt-unicodes text representation into a perl string. See
+Converts rxvt-unicode's text representation into a perl string. See
 C<< $term->ROW_t >> for details.
 =item $success = $term->grab_button ($button, $modifiermask[, $window = $term->vt])
 =item $term->ungrab_button ($button, $modifiermask[, $window = $term->vt])
 package urxvt::popup;
 =head2 The C<urxvt::popup> Class
-=over 4
+=over
 =cut
 sub add_item {
    my ($self, $item) = @_;
                     ->cb (sub {
                        $term->{overlay}->set (0, 0,
                           sprintf "%2d:%02d:%02d", (localtime urxvt::NOW)[2,1,0]);
                     });
-=over 4
+=over
 =item $timer = new urxvt::timer
 Create a new timer object in started state. It is scheduled to fire
 immediately.
                    sysread $term->{socket}, my $buf, 8192
                       or end-of-file;
                  });
-=over 4
+=over
 =item $iow = new urxvt::iow
 Create a new io watcher object in stopped state.
 This class implements idle watchers, that get called automatically when
 the process is idle. They should return as fast as possible, after doing
 some useful work.
-=over 4
+=over
 =item $iw = new urxvt::iw
 Create a new idle watcher object in stopped state.
                     ->cb (sub {
                        my ($pw, $exit_status) = @_;
                        ...
                     });
-=over 4
+=over
 =item $pw = new urxvt::pw
 Create a new process watcher in stopped state.
 =head2 URXVT_PERL_VERBOSITY
 This variable controls the verbosity level of the perl extension. Higher
 numbers indicate more verbose output.
-=over 4
+=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.264 by root, Sat Jul 24 09:42:15 2021 UTC vs. Revision 1.269 by root, Sun Nov 21 15:15:02 2021 UTC

Diff Legend

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.264 by root, Sat Jul 24 09:42:15 2021 UTC vs.
Revision 1.269 by root, Sun Nov 21 15:15:02 2021 UTC