#!/bin/sh
# the next line restart with wish \
exec wish "$0" "$@" 2>> /tmp/patchkernel.log

set about " # patchkernel 1.1 Copyright (C) 2000 Luc Deschenaux <lcd@gkb.com>\n\
# blabla NO WARRANTY blabla YOUR OWN RISK blabla GPL2\n\
# search on your harddisk for more info about GPL2\n"
# patchkernel track updates and/or patch Linux kernel

set nogui 0
set noconfirm 0
if {[set s [lsearch $argv {-nogui}]]>=0} {
  catch {wm withdraw .}
  set nogui 1
  set argv [lreplace $argv $s $s]
  incr argc -1
  set cons stdout 
} else {set cons /dev/console}

if {[set s [lsearch $argv {-yes}]]>=0} {
  set noconfirm 1
  set argv [lreplace $argv $s $s]
  incr argc -1
}

proc http_copy {url file} {
   set out [open $file w]
   set token [http::geturl $url -channel $out -handler http_handler -progress http_progress]
   if {$out!=""} {close $out}
   echo ""
   upvar #0 $token state
   foreach {name value} $state(meta) {
      if {[regexp -nocase ^location$ $name]} {
         echo [string trim $value]
         return [http_copy [string trim $value] $file]
      }
   }
   return $token
}

proc http_validate {url} {
   set token [http::geturl $url -headers {Pragma no-cache} -validate 1] 
   upvar #0 $token state
   foreach {name value} $state(meta) {
      if {[regexp -nocase ^location$ $name]} {
         echo [string trim $value]
         return [http_validate [string trim $value]]
      }
   }
   return $token
}

proc http_handler {socket token} {
  upvar #0 $token state
  fconfigure $socket -translation binary
  fconfigure $state(-channel) -translation binary
  return [fcopy $socket $state(-channel) -size 4096]
}

proc http_progress {args} {
   echo -nonewline \#
}

proc log_ui {root args} {

	if {$root == "."} {
	    set base ""
	} else {
	    set base $root
	}
    
	text $base.text#1 \
		-height 1 \
		-width 1 \
		-xscrollcommand "$base.scrollbar#2 set" \
		-yscrollcommand "$base.scrollbar#1 set"


	scrollbar $base.scrollbar#1 \
		-command "$base.text#1 yview" \
		-orient v

	scrollbar $base.scrollbar#2 \
		-command "$base.text#1 xview" \
		-orient h


	# Geometry management

	grid $base.text#1 -in $root	-row 1 -column 1  \
		-sticky nesw
	grid $base.scrollbar#1 -in $root	-row 1 -column 2  \
		-sticky ns
	grid $base.scrollbar#2 -in $root	-row 2 -column 1  \
		-sticky ew

	# Resize behavior management

	grid rowconfigure $root 1 -weight 1 -minsize 5
	grid rowconfigure $root 2 -weight 0 -minsize 2
	grid columnconfigure $root 1 -weight 1 -minsize 7
	grid columnconfigure $root 2 -weight 0 -minsize 2
# additional interface code
bind $base.text#1 <Keydown> {}

# end additional interface code

}

global kernelurl patchoptions expander zext linux src console failure
source /usr/local/etc/pk.conf

if {$nogui==0} {
  if {[catch {exec killall -0 xconsole}]} "exec nohup xconsole -daemon $console >& /dev/null & ; exec sleep 1"
}

set src [file dirname $linux]

proc echo {t args} {
  global nogui cons
  if {$nogui} {
    if {$t=={-nonewline}} {
      puts -nonewline stdout [string trim $args {\{\}}]
      flush stdout
    } else {
      puts stdout $t
    }
  } else {
    catch {
      .text#1 configure -state normal 
      if {$t=={-nonewline}} {
        .text#1 insert end [string trim $args {\{\}}]
      } else {
        .text#1 insert end "$t\n"
      }
      .text#1 configure -state disabled
      .text#1 see end
      update idletasks
    } err
    if {$err!=""} {
      set nogui 1
      set cons stdout 
      echo $t args
    } 
  }
}

proc preferences {} {
  set w .prefs
  if [catch {toplevel $w ; wm title $w "Preferences"}] {return TCL_OK}
  log_ui $w 
  menu $w.menu -tearoff 0
  set m $w.menu.file
  menu $m -tearoff 0
  $w.menu add cascade -label "File" -menu $m -underline 0
  $m add command -command {preferences_save} -label {Save} -accelerator Alt-S
  bind $w <Alt-s> {preferences_save}
  $m add separator
  $m add command -command "destroy $w" -label {Discard} -accelerator Alt-W
  bind $w <Alt-w> "destroy $w"
  $w configure -menu $w.menu
  set pf [open /usr/local/etc/pk.conf r]
  $w.text#1 insert end [read $pf]
  close $pf
  wm minsize $w 148 118 
  wm geometry $w 480x320
}

proc kversion {} {
  global linux src failure
  if [catch {set l [file readlink $linux]}] {
    set v [exec uname -r]
    if {$failure!=2} {
      if [catch {echo "Cant find $linux or $linux is not a link to $src/linux-$v\n"}] {
        set failure 1
      } else {set failure 2 ; preferences }
    }
    return $v 
  }
  return [lindex [split [file readlink $linux] {-}] end]   
}

set failure 0
set usage "Usage: pk \[-r\] \[limit\] \[-nogui\] \[-yes\]\nWhen Tk is not installed: \"tclsh pk \[options\]\"\nCurrent: [kversion]\n"

package require http

if {!$nogui} {
  if [catch {log_ui .}] {
    set nogui 1
    set cons stdout
  } else {
    wm title . "PatchKernel"
    bind . <Destroy> {exit 0}
    wm minsize . 148 118 
    wm geometry . 480x256

    menu .menu -tearoff 0

    set m .menu.file
    menu $m -tearoff 0
    .menu add cascade -label "File" -menu $m -underline 0
    $m add command -command {exit 0} -label {Quit} -accelerator Alt-Q
    bind all <Alt-q> {exit 0}

    set m .menu.edit
    menu $m -tearoff 0
    .menu add cascade -label "Edit" -menu $m -underline 0
    $m add command -command {preferences} -label {Preferences...} -accelerator Alt-K
    bind . <Alt-k> {preferences}

    set m .menu.help
    menu $m -tearoff 0
    .menu add cascade -label "Help" -menu $m -underline 0
    $m add command -command {echo "$usage\nYou may set the preferences in the edit menu\nMake sure $linux is a link to $src/linux-[kversion]\n"} -label {Help} -accelerator F1
    bind . <F11> {echo "$usage\nYou may set the preferences in the edit menu\nMake sure $linux is a link to $src/linux-[kversion]\n"}
    $m add separator
    $m add command -command {echo $about} -label {About}
    . configure -menu .menu
  }
}

if {[lsearch $argv {-h}]>=0} {
  echo $usage
  if {$nogui} {exit} else {return TCL_OK}
}

proc confirm {title msg args} {
  global noconfirm nogui
  if {$noconfirm} {
    return 1
  } else {
    if {$nogui} {
      if {$noconfirm} {
        if {$title=="Patch unavailable"} {return 0}
        return 1
      }
      puts stdout $title 
      set reply {}
      while {$reply=={}} {
        puts -nonewline stdout "$msg "
        flush stdout
        gets stdin reply
      }
      puts stdout {}
      if {[string index $reply 0]=="y"} {return 1}
      return 0
    }
  }
  if {[set l [llength $args]]!=0} {set yes [lindex $args 0]} else {set yes {Yes}}
  if {$l>1} {set no [lindex $args 1]} else {set no {No}}
  if {$l>2} {set default [lindex $args 2]} else {
    set default 1
    bind all <Escape> "catch {tkButtonInvoke .d.button0}"
  }
  if [tk_dialog .d $title $msg {} $default $no $yes] {
    return 1 
  }
  return 0 
}


proc preferences_save {} {
  set pf [open /usr/local/etc/pk.conf w]
  puts -nonewline $pf [.prefs.text#1 get 0.0 end]
  close $pf
  global kernelurl patchoptions expander zext linux src console
  source /usr/local/etc/pk.conf
  set src [file dirname $linux]
}

proc patchkernel {arg arg2 lim} {

  global kernelurl patchoptions zext expander src linux console failure cons nogui

  if {$arg=={-r}} {
    set reverse 1
    set arg $arg2 
  } else {set reverse 0}
  if {$arg!=""} {
    set v [split $arg .]
  } else { 
    set v [split [set lim [kversion]] .]
  }
  if {$lim==""} {set lim $arg}
  set v1 [lindex $v 0]
  set v2 [lindex $v 1]
  if {$reverse} {
    set v3 [expr [lindex $v 2]-1]
    set patchf patch-$v1.$v2.[lindex $v 2].$zext
  } else {
    set v3 [expr [lindex $v 2]+1]
    set patchf patch-$v1.$v2.$v3.$zext
  }
  set nextk $v1.$v2.$v3
  set url2check $kernelurl/v$v1.$v2/$patchf
  set getpatch 1
  echo "Looking for $url2check"
  set expanded [file exists $src/[file rootname $patchf]]  
  if {[file exists $src/$patchf] || $expanded!=0} {
    echo "Patch already here\n"
    set token here
  } else {
    set retry 3
    while {$retry} {
      set token {} 
      if {[catch "set token [http_validate $url2check]"]} {
        incr retry -1
        if {$retry} {continue}
        echo "Cant reach website\n" 
        return TCL_OK 
      }
      upvar #0 $token state
      if {[lindex $state(http) 1] != 200} {
        incr retry -1
        if {$retry} {continue}
        echo "[lrange $state(http) 2 end]\n"
        if {[lindex $state(http) 1] != 404} {
          return TCL_OK 
        }
      }
      break
    }
    if {!$retry} {
      set getpatch 0
      set retry 3
      set url2check $kernelurl/v$v1.$v2/linux-$nextk.tar.$zext
      echo "Looking for $url2check"
      while {$retry} {
        if {[catch "set token [http_validate $url2check]"]} {
          incr retry -1
          if {$retry} {continue}
          echo "Cant reach website\n" 
          return TCL_OK 
        }
        upvar #0 $token state
        if {[set err [lindex $state(http) 1]] != 200} {
          incr retry -1
          if {$retry} {continue}
          echo "[lrange $state(http) 2 end]\n"
          if {[lindex $state(http) 1] != 404} {
            return TCL_OK 
          }
        }
        break
      }
    }
    if {$retry} {
      echo "Found !\n"
    } else {
      echo "No update available\n"
      return TCL_OK
    }
  }
  if {$failure} {return TCL_OK}
  if {$getpatch} {
    if {!(($reverse==1 && [confirm "Removing patch" "Reverse-apply $patchf ?"]==1) || ($reverse==0 && [confirm "Kernel $nextk upgrade" "Patch me right now ?"]==1))} {
      echo "Operation cancelled\n"
      return TCL_OK 
    }
  }
  cd $src
  if {$token!="here"} {
    set token {}
    if {$getpatch} {
      set retry 3
      echo "Downloading $patchf"
      while {$retry} {    
        if {[catch "set token [http_copy $kernelurl/v$v1.$v2/$patchf $src/$patchf]"]} {
          catch "exec rm $src/$patchf"
          incr retry -1 
          if {$retry} {continue} 
          echo "Cant reach website\n" 
          return TCL_OK
        }
        if {$token==""} {
          catch "exec rm $src/$patchf"
          incr retry -1 
          if {$retry} {continue} 
          echo "Failed !\n"
          return TCL_OK 
        }
        upvar #0 $token state
        if {[lindex $state(http) 1]!=200} {
          catch "exec rm $src/$patchf"
          incr retry -1
          if {$retry} {continue}
          echo "[lrange $state(http) 2 end]\n"
          if {[lindex $state(http) 1]!=404} {
            return TCL_OK 
          }
        }
        break 
      }
      set getpatch $retry 
    }
    if {!$getpatch} {
      if {![confirm "Patch unavailable" "Download whole kernel ?"]} {
        echo "Operation cancelled\n"
        return TCL_OK 
      }
      set zkernel $src/linux-$nextk.tar.$zext
      if {[file exists $zkernel]} {
        echo "File already here\n"
        set token "here"
      } else {
        set url $kernelurl/v$v1.$v2/linux-$nextk.tar.$zext
        echo "Downloading $url"
        set retry 3
        while {$retry} {
          set token {}
          if {[catch "set token [http_copy $url $zkernel]"]} {
            catch "exec rm $zkernel"
            incr retry -1
            if {$retry} {continue}
            echo "Cant reach website\n" 
            return TCL_OK 
          }
          if {$token==""} {
            catch "exec rm $zkernel"
            incr retry -1
            if {$retry} {continue}
            echo "Failed !\n"
            return TCL_OK 
          }
          upvar #0 $token state
          if {[lindex $state(http) 1]!=200} {
            catch "exec rm $zkernel"
            incr retry -1
            if {$retry} {continue}
            echo "[lrange $state(http) 2 end]\n"
            if {[lindex $state(http) 1]!=404} { 
              return TCL_OK
            }
          }
          break
        }
        if {!$retry} {return TCL_OK}
      }
      echo "Extracting kernel source..."
      exec rm $linux
      if {[catch "exec bash -c \"source /etc/profile ; cd $src ; ($expander $zkernel | tar -x)\" >& $cons"]} {
        echo "Failed !\n"
        return TCL_OK 
      }
      echo "\nmv linux linux-$nextk"
      exec mv linux linux-$nextk
      echo "ln -sf linux-$nextk linux"
      exec ln -sf linux-$nextk linux
      echo "\nKernel source version is now $nextk\n"
      return TCL_OK
    }  
  }
  if {!$expanded} { 
    echo -nonewline Decompressing\ patch...
    if {[catch "exec bash -c \"source /etc/profile ; cd $src ; $expander $patchf\" >& $cons"]} {
      echo "Failed !\n"
      catch {exec rm $src/$patchf}
      return TCL_OK 
    } else {echo "Done.\n"}
  } else {echo "Already decompressed\n"}
  set patchf [file rootname $patchf]
  if {$reverse} {set w3 [lindex $v 2]} else {set w3 [expr $v3-1]}
  if {[file exists $linux/.config] && ![file exists $linux/.config-$v1.$v2.$w3]} {
    echo "Backuping $linux.config -> $linux/.config-$v1.$v2.$w3\n"
    exec cp $linux/.config $linux/.config-$v1.$v2.$w3
  }
  echo "patch $patchoptions($reverse) < $src/$patchf"
  if {![catch "exec patch $patchoptions($reverse) < $src/$patchf >& $cons"]} {
    echo "\nmv linux-$v1.$v2.[lindex $v 2] linux-$nextk"
    exec mv linux-$v1.$v2.[lindex $v 2] linux-$nextk
    echo "ln -sf linux-$nextk linux"
    exec ln -sf linux-$nextk linux 
    echo "\nKernel source version is now $nextk\n"
  } else {
    echo "An error occured while applying the patch.\n\nUndoing operation...\npatch $patchoptions([expr 1-$reverse]) \< $src/$patchf" > /dev/console
    if {![catch "exec patch $patchoptions([expr 1-$reverse]) < $src/$patchf >& $cons"]} {
      echo "Done.\n"
    } else {
      echo "Failed.\n"
    }
    if {$nogui} {exit 1} else {return TCL_OK}	
  }
  if {$reverse} {
    set v3 [lindex [split $nextk .] 2]
    if {[lindex [split $lim .] 2]==$v3 || $v3==1} {
      echo "Done\n"
      return TCL_OK
    }
    patchkernel -r $nextk $lim
  } else {
    if {[lindex [split $lim .] 2]<[lindex [split $nextk .] end]} {
      echo "Done\n"
      return TCL_OK
    }
    patchkernel $nextk {} $lim 
  }
  return TCL_OK 
}

if {[set s [lsearch $argv {-r}]]>=0} {
  set a {-r}
  set argv [lreplace $argv $s $s]
  set argv [linsert $argv 0 $a]
} else {
  set a [lindex $argv 0]
}

if {($a=={-r} && $argc>2)||($a!={-r} && $argc>1)} {
  echo $usage
  return TCL_OK 
}

set v [split [kversion] .]

if {$a=={-r}} {
  set c [lindex $argv 1] 
  if {$c==""} {
    set c [lindex $v 0].[lindex $v 1].1
    set noconfirm 0
  }
  set b [kversion] 
} else {
  if {$a==""} {
    set a [kversion]
    set c [lindex $v 0].[lindex $v 1].99999
  } else {
    set c $a
    set a {}
  }
  set b {}
}

patchkernel $a $b $c 
if {$nogui} {exit 0}
