#!/usr/bin/perl
use v5.36;

use Getopt::Std;
use HTTP::Tiny;
use IO::Socket qw(AF_INET SOCK_STREAM);
use IO::Socket::SSL;
use POSIX qw(strftime);
use MIME::Base64;
use LWP::UserAgent;
use JSON;

my $CHUNK_LENGTH = 1024;
my $NICK = 'bot';
my $USER = 'JohnDoe';
my $REAL = 'Smith';

my $chan = '#snack';
my $host = 'bjornix.cs.lth.se';
my $logging = 1;
my $port = '8090';
my $tls = 0;
my %subbuffer;

sub logger {
        my $logmessage = shift;
        open(my $logfile, ">>", "bot.log") or die "Can't open bot.log: $!";
        print $logfile strftime('%Y-%m-%dT%H:%M:%SZ ', gmtime()), $logmessage, "\n";
}

sub out {
        my ($sock, $message) = @_;
        logger($message) if ($logging);
        print $sock "$message\r\n";
}

sub msg {
        my ($sock, $message) = @_;
    my $payload = "userId=$NICK;msg=$message";
    my $length = length($payload);
    print STDOUT "payload: $payload, lengt: $length\n";
   
    my $length_char = chr($length);
    out($sock, "\x00" . $length_char . "userId=$NICK;msg=$message"); 

    #out($sock, "\x00\x" . sprintf("%x", $length) . $payload);
    # out($sock, "\x00\x0DuserId=$NICK;msg=$message");
}

# Function to trim whitespace from the beginning and end of a string
sub trim {
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}

# Function to check if a URL is an image
sub is_image_url {
    my $url = shift;
    
    # Check file extension
    return 1 if $url =~ /\.(jpg|jpeg|png|gif|bmp|webp)$/i;
    
    # Check content type if no extension match
    my $response = HTTP::Tiny->new->head($url);
    return 0 unless $response->{success};
    return 0 unless $response->{headers}->{'content-type'};
    return 1 if $response->{headers}->{'content-type'} =~ m,image/,;
    
    return 0;
}

# Function to download image and process with Ollama API
sub process_image {
    my $url = shift;
    my $ua = LWP::UserAgent->new();
    
    # Download the image
    my $img_response = $ua->get($url);
    unless ($img_response->is_success) {
        return "Failed to download image: " . $img_response->status_line;
    }
    
    # Convert image to base64
    my $base64_img = encode_base64($img_response->content);
    $base64_img =~ s/\n//g; # Remove newlines from base64 string
    
    # Prepare request for Ollama API
    my $json_content = {
        model => "llava:7b",
        stream => JSON::false,
        #prompt => "Answer in max one sentence never more. Always say the opposite. It's opposite day. What is in this picture?",
        prompt => "Answer in max one sentence never more with rude pessimistic tone. What is in this picture?",
        #prompt => "What is in this picture?",
        images => [$base64_img]
    };
    
    # Convert Perl data structure to JSON string
    my $json_string = encode_json($json_content);
    
    # Make request to Ollama API
    my $ollama_response = $ua->post(
        'http://localhost:11434/api/generate',
        'Content-Type' => 'application/json',
        Content => $json_string
    );
    
    unless ($ollama_response->is_success) {
        return "Image analysis failed: " . $ollama_response->status_line;
    }
    
    # Parse the response
    my $result;
    eval {
        $result = decode_json($ollama_response->content);
    };
    
    if ($@) {
        return "Failed to parse API response: $@";
    }
    
    return "Image analysis: " . $result->{response};
}

# respond to channel
# returns 1 if bot shouldn't remember last message for s///, 0 otherwise
sub respond {
        my ($sock, $sender_nick, $message) = @_;
        # if no triggers found, check for mentions
        if ($message =~ m,(https?://[^\000\r\n ]+)$,) {
                my $url = $1;
                
                # First check if it's an image
                if (is_image_url($url)) {
                        # Process image with Ollama API
                        my $analysis = process_image($url);
                        msg($sock, $analysis);
                        return 0;
                }
                
                # If not an image, continue with original URL handling
                my $response = HTTP::Tiny->new->head($url);
                unless ($response->{success}) {
                        msg($sock, "failed to get info about link: $url <[x~x]> ($response->{status} $response->{reason}!)");
                        return 0;
                }
                unless ($response->{headers}->{'content-type'}) {
                        msg($sock, "failed to get info about link: $url <[x~x]> (no     ``content-type'' header found in HTTP response!)");
                        return 0;
                }
                unless ($response->{headers}->{'content-type'} =~ m,text/html,) {
                        # we got a non text/html content type
                        msg($sock, "File: $response->{headers}->{'content-type'}");
                        return 0;
                }

                # if it's text/html, GET it's title
                $response = HTTP::Tiny->new->get($url);
                unless ($response->{success}) {
                        msg($sock, "failed to get title of link $url <[x~x]> ($response->{status} $response->{reason}!)");
                        return 0;
                }
                unless (length $response->{content}) {
                        msg($sock, "failed to get title of link $url <[x~x]> (HTTP response empty!)");
                        return 0;
                }
                my $content = $response->{content};
                if ($content =~ m,<title[^>]*>([^<]+)</title[^>]*>,) {
                        my $title = $1;
                        $title =~ tr/[\000\r\n]//d;
                        $title = trim($title);
                        msg($sock, "Title: $title");
                } else {
                        msg($sock, "failed to get title of link $url <[x~x]> (no title found!)");
                }
        }
        return 0;
}

# process args
getopts('h:j:lp:t', \my %opts);
$chan = $opts{'j'} if ($opts{'j'});
$host = $opts{'h'} if ($opts{'h'});
$logging = 1 if ($opts{'l'});
$port = $opts{'p'} if ($opts{'p'});
$tls = 0 if ($opts{'t'});

# start the connection
my $sock;
if ($tls) {
        $sock = IO::Socket::SSL->new(
                Domain => AF_INET,
                Type => SOCK_STREAM,
                PeerHost => $host,
                PeerPort => $port,
        ) || die "Can't open socket: $IO::Socket::errstr";
} else {
        $sock = IO::Socket->new(
                Domain => AF_INET,
                Type => SOCK_STREAM,
                proto => 'tcp',
                PeerHost => $host,
                PeerPort => $port,
        ) || die "Can't open socket: $IO::Socket::errstr";
}

# set user, real, and nick, then join
#out($sock, "USER $USER * * :$REAL");
#out($sock, "NICK $NICK");
#out($sock, "JOIN $chan");
#out($sock, "\x00\x0DuserId=$NICK;msg=bot\x03");
#out($sock, "\x00\x1duserId=$NICK;msg='hello woorld'");
#out($sock, "\x00\x1duserId=$NICK;msg='bots wooorld'");
#print STDOUT "Welcome to our little program\n";


# evasdrop
my $buffer = '';
my $chunk = '';
my $message = '';
while (1) {
        # buffer up
        if ($tls) {
                $chunk = <$sock>;
        } else {
                $sock->recv($chunk, $CHUNK_LENGTH);
        }
    #$chunk =~ /^([^\r\n]+)(\r\n)?([^\r\n]+)?$/;
        ## keep reading if chunk is empty
        #next if (not $1);
        ## if chunks isn't empty, check for framing point
    #print STDOUT "Welcome. $chunk\n";
        #if ($2) {
        #       # if we found a framing point, flush buffer and text till framing point
        #       $message = $buffer . $1;
        #       if ($3) {
        #               # if we have text after framing, make it the new content of buffer
        #               $buffer = $3;
        #       } else {
        #               # if we have no text after framing, clear buffer
        #               $buffer = '';
        #       }
        #} else {
        #       # if there's no framing. append chunk to end of buffer and keep reading
        #       $buffer .= $chunk;
        #       next;
        #}
    $message = $chunk;
    print STDOUT "Welcome. $message\n";
        # log message
        logger($message) if ($logging);

        # respond to message
        if ($message =~ /^PING :([^\000\r\n\ ]+)$/) {
                # if we got a ping, pong back
                out($sock, "PONG :$1");
        print STDOUT "Received a message\n";
    } elsif ($message =~ /.*?userid=([^;]*);msg=(.*)$/i) { 
                # if we got a message to our chan. read and act accordingly
        print STDOUT "Received a message\n";
        my $sender_nick = $1;
                my $sender_message = $2;
                unless (respond($sock, $sender_nick, $sender_message)) {
                        $subbuffer{$sender_nick} = $sender_message;
                }
        }
}

Generated by Getz using scpaste at Sat Mar 22 12:11:29 2025. CET. (original)