package Linux::FANotify;
use 5.016;
use strict;
use warnings;
my $ccode;
BEGIN {
my @constants=qw(
                    FAN_ACCESS
                    FAN_MODIFY
                    FAN_CLOSE_WRITE
                    FAN_CLOSE_NOWRITE
                    FAN_OPEN
                    FAN_Q_OVERFLOW
                    FAN_OPEN_PERM
                    FAN_ACCESS_PERM
                    FAN_ONDIR
                    FAN_EVENT_ON_CHILD
                    FAN_CLOSE
                    FAN_CLOEXEC
                    FAN_NONBLOCK
                    FAN_CLASS_NOTIF
                    FAN_CLASS_CONTENT
                    FAN_CLASS_PRE_CONTENT
                    FAN_ALL_CLASS_BITS
                    FAN_UNLIMITED_QUEUE
                    FAN_UNLIMITED_MARKS
                    FAN_ALL_INIT_FLAGS
                    FAN_MARK_ADD
                    FAN_MARK_REMOVE
                    FAN_MARK_DONT_FOLLOW
                    FAN_MARK_ONLYDIR
                    FAN_MARK_MOUNT
                    FAN_MARK_IGNORED_MASK
                    FAN_MARK_IGNORED_SURV_MODIFY
                    FAN_MARK_FLUSH
                    FAN_ALL_MARK_FLAGS
                    FAN_ALL_EVENTS
                    FAN_ALL_PERM_EVENTS
                    FAN_ALL_OUTGOING_EVENTS
                    FANOTIFY_METADATA_VERSION
                    FAN_ALLOW
                    FAN_DENY
                    FAN_NOFD
            );
$ccode=<<EOC;
#include <sys/fanotify.h>
#include <stdlib.h>
#include <string.h>
EOC
for my $c (@constants) {
    my $sub_name = lc($c =~ s{^.*?_}{}r);
    $ccode .= "long CONST_${sub_name}() { return $c; }\n";
}
$ccode.=<<EOC;
int perl_fanotify_init(unsigned int flags, unsigned int event_f_flags) {
    return fanotify_init(flags,event_f_flags);
}

int perl_fanotify_mark(int fanotify_fd, unsigned int flags,
                       unsigned long mask, int dfd, const char *pathname) {
    return fanotify_mark(fanotify_fd, flags, mask, dfd, pathname);
}

SV* perl_memalign(size_t alignment, size_t size) {
  void* buffer=NULL;
  int err;
  err = posix_memalign(&buffer, alignment, size);
  if (err != 0 || buffer == NULL) {
    SV* bang = get_sv("!", 0);
    sv_setiv(bang, (IV)err);
    sv_setpvf(bang, "%s", strerror(err)); /* let Perl copy the string */
    SvIOK_on(bang);
    return &PL_sv_undef;
  }
  return sv_2mortal(newSVpvn(buffer,size));
}
AV* unpack_events(SV* svbuffer) {
    STRLEN len;
    void * buffer = SvPV(svbuffer,len);
    AV* ret = newAV();
    HV* event;
    struct fanotify_event_metadata *data;
    data = (struct fanotify_event_metadata *) buffer;

    while(FAN_EVENT_OK(data,len)) {
        event = newHV();
        av_push(ret,newRV_noinc((SV*)event));
        hv_store(event,"mask",4,newSViv(data->mask),0);
        hv_store(event,"fd",2,newSViv(data->fd),0);
        hv_store(event,"pid",3,newSViv(data->pid),0);
        buffer = FAN_EVENT_NEXT(data,len);
    }

    return ret;
}
EOC
}
use Inline C => $ccode;
use POSIX qw();
use Data::Printer;

my $fan_fd = perl_fanotify_init(0,0);

warn "fan fd: $fan_fd $!";
my $fan_fh;open($fan_fh,'<&=',$fan_fd);

my $ret = perl_fanotify_mark($fan_fd,
                        CONST_mark_add | CONST_mark_mount,
                        CONST_open | CONST_close, 0, '/tmp');
if ($ret < 0) {
    die "WTF? $ret";
}

my $buffer;#=perl_memalign(4096,8192);

sub program_for_pid {
    my ($pid) = @_;

    my $ret = "<unknown program ($pid)>";

    open my $fh,'<',"/proc/$pid/cmdline" or return $ret;

    my $cmdline = do { local $/;<$fh> };chomp $cmdline;

    return $cmdline || $ret;
}

sub print_event {
    my ($ev) = @_;

    my $procname = program_for_pid($ev->{pid});
    my $filename = readlink "/proc/self/fd/".$ev->{fd};
    $filename ||= "<unknown file ($ev->{fd})>";
    my $mask = $ev->{mask};

    print "$procname ($mask) $filename\n";
    POSIX::close($ev->{fd});
}

while (1) {
    my $len = sysread($fan_fh,$buffer,8192,0);
    my $ret = unpack_events($buffer);

    for my $ev (@$ret) {
        print_event($ev);
    }
}

close $fan_fh;