plugins/fishlim/fish.h


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

/*

  Copyright (c) 2010 Samuel Lidén Borell <samuel@kodafritt.se>

  Permission is hereby granted, free of charge, to any person obtaining a copy
  of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction, including without limitation the rights
  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  THE SOFTWARE.

*/

#ifndef FISH_H
#define FISH_H

#include <stdbool.h>
#include <stddef.h>

char *fish_encrypt(const char *key, size_t keylen, const char *message);
char *fish_decrypt(const char *key, size_t keylen, const char *data);
char *fish_encrypt_for_nick(const char *nick, const char *data);
char *fish_decrypt_from_nick(const char *nick, const char *data);

#endif
package Xchat::Embed;
use strict;
use warnings;
# list of loaded scripts keyed by their package names
# The package names are generated from the filename of the script using
# the file2pkg() function.
# The values of this hash are hash references with the following keys:
#   filename
#     The full path to the script.
#   gui_entry
#     This is xchat_plugin pointer that is used to remove the script from
#     Plugins and Scripts window when a script is unloaded. This has also
#     been converted with the PTR2IV() macro.
#   hooks
#     This is an array of hooks that are associated with this script.
#     These are pointers that have been converted with the PTR2IV() macro.
#   inner_packages
#     Other packages that are defined in a script. This is not recommended
#     partly because these will also get removed when a script is unloaded.
#   loaded_at
#     A timestamp of when the script was loaded. The value is whatever
#     Time::HiRes::time() returns. This is used to retain load order when
#     using the RELOADALL command.
#   shutdown
#     This is either a code ref or undef. It will be executed just before a
#     script is unloaded.
our %scripts;

# This is a mapping of "inner package" => "containing script package"
our %owner_package;

# used to keep track of which package a hook belongs to, if the normal way of
# checking which script is calling a hook function fails this will be used
# instead. When a hook is created this will be copied to the HookData structure
# and when a callback is invoked this it will be used to set this value.
our $current_package;

sub load {
	my $file = expand_homedir( shift @_ );
	my $package = file2pkg( $file );
	
	if( exists $scripts{$package} ) {
		my $pkg_info = pkg_info( $package );
		my $filename = File::Basename::basename( $pkg_info->{filename} );
		Xchat::printf(
			qq{'%s' already loaded from '%s'.\n},
			$filename, $pkg_info->{filename}
		);
		Xchat::print(
			'If this is a different script then it rename and try '.
			'loading it again.'
		);
		return 2;
	}
	
	if( open my $source_handle, $file ) {
		my $source = do {local $/; <$source_handle>};
		close $source_handle;
		# we shouldn't care about things after __END__
		$source =~ s/^__END__.*//ms;
		
		# this must come before the eval or the filename will not be found in
		# Xchat::register
		$scripts{$package}{filename} = $file;
		$scripts{$package}{loaded_at} = Time::HiRes::time();

		# this must be done before the error check so the unload will remove
		# any inner packages defined by the script. if a script fails to load
		# then any inner packages need to be removed as well.
		my @inner_packages = $source =~
			m/^\s*package \s+
				((?:[^\W:]+(?:::)?)+)\s*? # package name
				# strict version number
				(?:\d+(?:[.]\d+) # positive integer or decimal-fraction
					|v\d+(?:[.]\d+){2,})? # dotted-decimal v-string
				[{;]
			/mgx;

		# check if any inner package defined in the to be loaded script has
		# already been defined by another script
		my @conflicts;
		for my $inner ( @inner_packages ) {
			if( exists $owner_package{ $inner } ) {
				push @conflicts, $inner;
			}
		}

		# report conflicts and bail out
		if( @conflicts ) {
			my $error_message =
				"'$file' won't be loaded due to conflicting inner packages:\n";
			for my $conflict_package ( @conflicts ) {
				$error_message .= "   $conflict_package already defined in " .
					pkg_info($owner_package{ $conflict_package })->{filename}."\n";
			}
			Xchat::print( $error_message );

			return 2;
		}

		my $full_path = File::Spec->rel2abs( $file );
		$source =~ s/^/#line 1 "$full_path"\n\x7Bpackage $package;/;

		# make sure we add the closing } even if the last line is a comment
		if( $source =~ /^#.*\Z/m ) {
			$source =~ s/^(?=#.*\Z)/\x7D/m;
		} else {
			$source =~ s/\Z/\x7D/;
		}

		$scripts{$package}{inner_packages} = [ @inner_packages ];
		@owner_package{ @inner_packages } = ($package) x @inner_packages;
		_do_eval( $source );

		unless( exists $scripts{$package}{gui_entry} ) {
			$scripts{$package}{gui_entry} =
				Xchat::Internal::register(
					"", "unknown", "", $file
				);
		}

		if( $@ ) {
			# something went wrong
			$@ =~ s/\(eval \d+\)/$file/g;
			Xchat::print( "Error loading '$file':\n$@\n" );
			# make sure the script list doesn't contain false information
			unload( $scripts{$package}{filename} );
			return 1;
		}
	} else {
		Xchat::print( "Error opening '$file': $!\n" );
		return 2;
	}

	return 0;
}

sub _do_eval {
	no strict;
	no warnings;
	eval $_[0];
}

sub unload {
	my $file = shift @_;
	my $package = file2pkg( $file );
	my $pkg_info = pkg_info( $package );

	if( $pkg_info ) {	
		# take care of the shutdown callback
		if( exists $pkg_info->{shutdown} ) {
			# allow incorrectly written scripts to be unloaded
			eval {
				if( ref $pkg_info->{shutdown} eq 'CODE' ) {
					$pkg_info->{shutdown}->();
				} elsif ( $pkg_info->{shutdown} ) {
					no strict 'refs';
					&{$pkg_info->{shutdown}};
				}
			};
		}

		if( exists $pkg_info->{hooks} ) {
			for my $hook ( @{$pkg_info->{hooks}} ) {
				Xchat::unhook( $hook, $package );
			}
		}

		if( exists $pkg_info->{gui_entry} ) {
			plugingui_remove( $pkg_info->{gui_entry} );
		}
		
		delete @owner_package{ @{$pkg_info->{inner_packages}} };
		for my $inner_package ( @{$pkg_info->{inner_packages}} ) {
			Symbol::delete_package( $inner_package );
		}
		Symbol::delete_package( $package );
		delete $scripts{$package};
		return Xchat::EAT_ALL;
	} else {
		Xchat::print( qq{"$file" is not loaded.\n} );
		return Xchat::EAT_NONE;
	}
}

sub unload_all {
	for my $package ( keys %scripts ) {
		unload( $scripts{$package}->{filename} );
	}
	
	return Xchat::EAT_ALL;
}

sub reload {
	my $file = shift @_;
	my $package = file2pkg( $file );
	my $pkg_info = pkg_info( $package );
	my $fullpath = $file;
	
	if( $pkg_info ) {
		$fullpath = $pkg_info->{filename};
		unload( $file );
	}
	
	load( $fullpath );
	return Xchat::EAT_ALL;
}

sub reload_all {
	my @dirs = Xchat::get_info( "xchatdirfs" ) || Xchat::get_info( "xchatdir" );
	push @dirs, File::Spec->catdir( $dirs[0], "plugins" );
	for my $dir ( @dirs ) {
		my $auto_load_glob = File::Spec->catfile( $dir, "*.pl" );
		my @scripts = map { $_->{filename} }
			sort { $a->{loaded_at} <=> $b->{loaded_at} } values %scripts;
		push @scripts, File::Glob::bsd_glob( $auto_load_glob );

		my %seen;
		@scripts = grep { !$seen{ $_ }++ } @scripts;

		unload_all();
		for my $script ( @scripts ) {
			if( !pkg_info( file2pkg( $script ) ) ) {
				load( $script );
			}
		}
	}
}

sub expand_homedir {
	my $file = shift @_;

	if ( $^O eq "MSWin32" ) {
		$file =~ s/^~/$ENV{USERPROFILE}/;
	} else {
		$file =~ s{^~}{
			(getpwuid($>))[7] ||  $ENV{HOME} || $ENV{LOGDIR}
		}ex;
	}
	return $file;
}

sub file2pkg {
	my $string = File::Basename::basename( shift @_ );
	$string =~ s/\.pl$//i;
	$string =~ s|([^A-Za-z0-9/])|'_'.unpack("H*",$1)|eg;
	return "Xchat::Script::" . $string;
}

sub pkg_info {
	my $package = shift @_;
	return $scripts{$package};
}

sub find_external_pkg {
	my $level = 1;

	while( my @frame = caller( $level ) ) {
		return @frame if $frame[0] !~ /(?:^IRC$|^Xchat)/;
		$level++;
	}
	return;
}

sub find_pkg {
	my $level = 1;

	while( my ($package, $file, $line) = caller( $level ) ) {
		return $package if $package =~ /^Xchat::Script::/;
		$level++;
	}

	my $current_package = get_current_package();
	if( defined $current_package ) {
		return $current_package;
	}

	my @frame = find_external_pkg();
	my $location;

	if( $frame[0] or $frame[1] ) {
		my $calling_package = $frame[0];
		if( defined( my $owner = $owner_package{ $calling_package } ) ) {
			return ($owner, $calling_package);
		}

		$location = $frame[1] ? $frame[1] : "package $frame[0]";
		$location .= " line $frame[2]";
	} else {
		$location = "unknown location";
	}

	die "Unable to determine which script this hook belongs to. at $location\n";

}

# convert function names into code references
sub fix_callback {
	my ($package, $calling_package, $callback) = @_;
	
	unless( ref $callback ) {
		unless( $callback =~ /::/ ) {
			my $prefix = defined $calling_package ? $calling_package : $package;
			$callback =~ s/^/${prefix}::/;
		}

		no strict 'subs';
		$callback = \&{$callback};
	}
	
	return $callback;
}

sub get_current_package {
	return $current_package;
}

sub set_current_package {
	my $old_package = $current_package;
	$current_package = shift;

	return $old_package;
}

1